(* SPKI SEXP *)

exception Syntax_error of string

type display_hint_t = {hint : t; body : t}
and t =
  | Str of string
  | Hint of display_hint_t
  | Arr of t list

let _output_str ch s =
  output_string ch (string_of_int (String.length s));
  output_char ch ':';
  output_string ch s

let rec output_sexp ch x =
  match x with
  | Str s ->
      _output_str ch s
  | Hint {hint = h; body = b} ->
      output_char ch '[';
      output_sexp ch h;
      output_char ch ']';
      output_sexp ch b
  | Arr xs ->
      output_char ch '(';
      output_sexps ch xs;
      output_char ch ')'

and output_sexps ch xs =
  match xs with
  | [] ->
      ()
  | x :: xs' ->
      output_sexp ch x;
      output_sexps ch xs'

let output_sexp_and_flush ch x =
  output_sexp ch x;
  flush ch

let char_numeric c = '0' <= c && c <= '9'
let char_whitespace c = c <= ' '

let digit_val c = (int_of_char c) - (int_of_char '0')

let input_bytes count ch =
  let buf = String.create count in (* mutable strings?!?! *)
  really_input ch buf 0 count;
  Str buf

let syntax_error explanation = raise (Syntax_error explanation)

let rec input_simple_string len ch =
  match input_char ch with
  | ':' -> input_bytes len ch
  | b when char_numeric b -> input_simple_string (len * 10 + digit_val b) ch
  | _ -> syntax_error "Bad simple-string length character"

let rec input_sexp_list ch =
  let rec collect acc =
    match input_sexp_inner ch with
    | None -> Arr (List.rev acc)
    | Some v -> collect (v :: acc)
  in collect []

and input_sexp_inner ch =
  match input_char ch with
  | '(' -> Some (input_sexp_list ch)
  | ')' -> None
  | '[' ->
      let hint = input_simple_string 0 ch in
      (match input_char ch with
      | ']' -> Some (Hint {hint = hint; body = input_simple_string 0 ch})
      | _ -> syntax_error "Missing close-bracket in display hint")
  | b when char_numeric b ->
      Some (input_simple_string (digit_val b) ch)
  | b when char_whitespace b ->
      (* Convenience for testing *)
      input_sexp_inner ch
  | _ ->
      syntax_error "Bad SEXP input character"

let input_sexp ch =
  match input_sexp_inner ch with
  | None -> syntax_error "Unexpected end of list"
  | Some v -> v