(*****************************************************************************
 * Lexer
 *****************************************************************************)

open List;;

type term_token  = Kwd of char | Ident of string | Int of int
and  token_stream = term_token Stream.t;;


(* Caractères reconnus par le lexer *)
let special_chars = ['('; ')'; '['; ']'; '<'; '>'; '{'; '}';
                     '$'; '#'; '^'; '.';'*']
;;

let term_lexer : string -> token_stream = fun s ->
  let pos = ref 0
  and length = String.length(s)

  in let rec parse_int : unit -> int = fun () ->
    let rec read_int : unit -> (int * int) = fun () ->
      if (!pos >= length) then (0, 1)
      else match s.[!pos] with
        ('0'..'9' as c) ->
          incr pos;
          let (res, base) = read_int ()
          in (res + (Char.code c - Char.code '0') * base, 10 * base)
      | _ -> (0, 1)
    in fst (read_int())

  and parse_ident : unit -> string = fun () ->
    let beg = !pos in
    let rec read_ident : unit -> string = fun () ->
      if !pos >= length then String.sub s beg (!pos - beg)
      else
        match s.[!pos] with
          ('a'..'z' | 'A'..'Z' | '0'..'9' | '_' | '-') ->
            incr pos; read_ident ()
        | _ -> String.sub s beg (!pos - beg)
    in incr pos; read_ident ()

  and next_token : int -> term_token option = fun count ->
    if !pos >= length then None
    else let c = s.[!pos] in
      if mem c special_chars then (incr pos; Some(Kwd(c)))
      else match c with
          (' ' | '\n' | '\t')   -> incr pos; next_token count
        | ('0'..'9')            -> Some(Int(parse_int()))
        | ('a'..'z' | 'A'..'Z') -> Some(Ident(parse_ident()))
        | _                     -> failwith "invalid char"

  in Stream.from next_token
;;

(* Pour tester le lexer *)
let tokens_of_string : string -> term_token list = fun s ->
  let s = term_lexer s
  in let rec tokens () =
    try
      let t = Stream.next s
      in t::(tokens ())
    with Stream.Failure -> []
  in tokens ();;

(* Rang de la première occurrence d'un nom de variable dans une liste ;
   utilisé par les parsers pour calculer les indices de de Bruijn *)
let index_of : string -> string list -> int =
  let rec index : int -> string -> string list -> int = fun i x ->
    function
        y::l -> if (x = y) then i else index (i + 1) x l
      | []   -> raise (Stream.Error "Free variable")
  in index 0
;;