scan.mll

{
    (* short names for important modules *)
    module L = Lexing 
    module B = Buffer

    type token = 
    | STR of string
    | VAR of string


let get      = L.lexeme
let sprintf  = Printf.sprintf

let position lexbuf =
    let p = lexbuf.L.lex_curr_p in
        sprintf "%s:%d:%d" 
        p.L.pos_fname p.L.pos_lnum (p.L.pos_cnum - p.L.pos_bol)

let set_filename (fname:string) (lexbuf:L.lexbuf)  =
    ( lexbuf.L.lex_curr_p <-  
        { lexbuf.L.lex_curr_p with L.pos_fname = fname }
    ; lexbuf
    )

exception Error of string
let error lexbuf fmt = 
    Printf.kprintf (fun msg -> 
        raise (Error ((position lexbuf)^" "^msg))) fmt

}

rule string b acc = parse
| '{'       { let s = B.contents b in 
              let v = variable (B.create 100) 0 lexbuf in
              string (B.create 100) (VAR(v)::STR(s)::acc) lexbuf
            }
| "\\{"     { B.add_string b "{" ; string b acc lexbuf }  
| "\\}"     { B.add_string b "}" ; string b acc lexbuf }  
| "\\" _    { error lexbuf "unrecognized escape: %s" (get lexbuf) }
| _         { B.add_string b (get lexbuf); string b acc lexbuf }
| eof       { let s   = B.contents b in 
              let acc = STR(s)::acc in
              List.rev acc
            }
 
and variable b n = parse
| '}'       { if n = 0 then 
                let s = B.contents b in s 
              else begin
                B.add_string b (get lexbuf); variable b (n-1) lexbuf
              end
            }
| '{'       { B.add_string b (get lexbuf); variable b (n+1) lexbuf }
| _         { B.add_string b (get lexbuf); variable b n lexbuf }
| eof       { error lexbuf "unexpected end of string" }

{

let to_string = function
| STR(str)          -> sprintf "STR(%s)" str
| VAR(str)          -> sprintf "VAR(%s)" str

let main name =
    let lexbuf = set_filename name @@ L.from_channel stdin in
    let buf    = B.create 100 in
        string buf [] lexbuf 
        |> List.map to_string
        |> String.concat " " 
        |> print_endline

}