(* The run-time library for lexers generated by mosmllex *)

open Obj;

datatype lexbuf = LEXBUF of
  (* refillBuff *)     (lexbuf -> unit) *
  (* lexBuffer *)      string *
  (* lexAbsPos *)      int *
  (* lexStartPos *)    int *
  (* lexCurrPos *)     int *
  (* lexLastPos *)     int *
  (* lexLastAction *)  (lexbuf -> obj)
;

prim_val getRefillBuff    : lexbuf -> (lexbuf -> unit) = 1 "field0";
prim_val getLexBuffer     : lexbuf -> string           = 1 "field1";
prim_val getLexAbsPos     : lexbuf -> int              = 1 "field2";
prim_val getLexStartPos   : lexbuf -> int              = 1 "field3";
prim_val getLexCurrPos    : lexbuf -> int              = 1 "field4";
prim_val getLexLastPos    : lexbuf -> int              = 1 "field5";
prim_val getLexLastAction : lexbuf -> (lexbuf -> obj)  = 1 "field6";

prim_val setRefillBuff    : lexbuf -> (lexbuf -> unit) -> unit = 2 "setfield0";
prim_val setLexBuffer     : lexbuf -> string -> unit           = 2 "setfield1";
prim_val setLexAbsPos     : lexbuf -> int -> unit              = 2 "setfield2";
prim_val setLexStartPos   : lexbuf -> int -> unit              = 2 "setfield3";
prim_val setLexCurrPos    : lexbuf -> int -> unit              = 2 "setfield4";
prim_val setLexLastPos    : lexbuf -> int -> unit              = 2 "setfield5";
prim_val setLexLastAction : lexbuf -> (lexbuf -> obj) -> unit  = 2 "setfield6";

prim_val create_string_ : int -> string                 = 1 "create_string";
prim_val nth_char_      : string -> int -> char         = 2 "get_nth_char";
prim_val set_nth_char_  : string -> int -> int -> unit  = 3 "set_nth_char";
prim_val blit_string_   : string -> int -> string -> int -> int -> unit
                                                        = 5 "blit_string"

val lexAuxBuffer = create_string_ 1024;
val charBuffer = magic(ref lexAuxBuffer) : CharArray.array;

fun lexRefill readFun lexbuf =
  let
    val read = readFun charBuffer 1024
    val n = if read > 0 then read
            else (set_nth_char_ lexAuxBuffer 0 0; 1)
  in
    blit_string_ (getLexBuffer lexbuf) n (getLexBuffer lexbuf) 0 (2048 - n);
    blit_string_ lexAuxBuffer 0 (getLexBuffer lexbuf) (2048 - n) n;
    setLexAbsPos lexbuf (getLexAbsPos lexbuf + n);
    setLexCurrPos lexbuf (getLexCurrPos lexbuf - n);
    setLexStartPos lexbuf (getLexStartPos lexbuf - n);
    setLexLastPos lexbuf (getLexLastPos lexbuf - n);
    if getLexStartPos lexbuf < 0 then
      raise Fail "lexer: token too long"
    else ()
  end
;

fun dummyAction x = raise Fail "lexer: illegal symbol in input";

fun createLexer f = LEXBUF
  (lexRefill f, create_string_ 2048, ~2048, 2048, 2048, 2048, dummyAction)
;

fun createLexerString s = LEXBUF
  ( fn lexbuf => setLexCurrPos lexbuf (getLexCurrPos lexbuf - 1),
    s ^ "\000", 0, 0, 0, 0, dummyAction )
;

fun getLexeme lexbuf =
  let
    val len = getLexCurrPos lexbuf - getLexStartPos lexbuf
    val s = create_string_ len
  in
    blit_string_ (getLexBuffer lexbuf) (getLexStartPos lexbuf) s 0 len; s
  end
;

fun getLexemeChar lexbuf i =
  nth_char_ (getLexBuffer lexbuf) (getLexStartPos lexbuf + i)
;

fun backtrack lexbuf =
  (setLexCurrPos lexbuf (getLexLastPos lexbuf);
   magic_obj ((getLexLastAction lexbuf) lexbuf))
;

fun getLexemeStart lexbuf =
  getLexAbsPos lexbuf + getLexStartPos lexbuf
;

fun getLexemeEnd lexbuf =
  getLexAbsPos lexbuf + getLexCurrPos lexbuf
;

prim_val getNextChar : lexbuf -> char = 1 "get_next_char";
