menhir-stat/stat_parser.ml

open Raw_parser

let token_of_string = function
  | "AMPERAMPER"   -> AMPERAMPER
  | "AMPERSAND"    -> AMPERSAND
  | "AND"          -> AND
  | "ANDOP"        -> ANDOP
  | "AS"           -> AS
  | "ASSERT"       -> ASSERT
  | "BACKQUOTE"    -> BACKQUOTE
  | "BANG"         -> BANG
  | "BAR"          -> BAR
  | "BARBAR"       -> BARBAR
  | "BARRBRACKET"  -> BARRBRACKET
  | "BEGIN"        -> BEGIN
  | "CHAR"         -> CHAR
  | "CLASS"        -> CLASS
  | "COLON"        -> COLON
  | "COLONCOLON"   -> COLONCOLON
  | "COLONEQUAL"   -> COLONEQUAL
  | "COLONGREATER" -> COLONGREATER
  | "COMMA"        -> COMMA
  | "COMMENT"      -> COMMENT
  | "CONSTRAINT"   -> CONSTRAINT
  | "DO"           -> DO
  | "DOCSTRING"    -> DOCSTRING
  | "DONE"         -> DONE
  | "DOT"         -> DOT
  | "DOTDOT"      -> DOTDOT
  | "DOTOP"       -> DOTOP
  | "DOWNTO"      -> DOWNTO
  | "ELSE"        -> ELSE
  | "END"         -> END
  | "EOF"         -> EOF
  | "EOL"         -> EOL
  | "EQUAL"       -> EQUAL
  | "EXCEPTION"   -> EXCEPTION
  | "EXTERNAL"    -> EXTERNAL
  | "FALSE"       -> FALSE
  | "FLOAT"       -> FLOAT
  | "FOR"         -> FOR
  | "FUN"         -> FUN
  | "FUNCTION"    -> FUNCTION
  | "FUNCTOR"     -> FUNCTOR
  | "GREATER"     -> GREATER
  | "GREATERRBRACE" -> GREATERRBRACE
  | "GREATERRBRACKET" -> GREATERRBRACKET
  | "HASH"        -> HASH
  | "HASHOP"      -> HASHOP
  | "IF"          -> IF
  | "IN"          -> IN
  | "INCLUDE"     -> INCLUDE
  | "INFIXOP0"    -> INFIXOP0
  | "INFIXOP1"    -> INFIXOP1
  | "INFIXOP2"    -> INFIXOP2
  | "INFIXOP3"    -> INFIXOP3
  | "INFIXOP4"    -> INFIXOP4
  | "INHERIT"     -> INHERIT
  | "INITIALIZER" -> INITIALIZER
  | "INT"         -> INT
  | "LABEL"       -> LABEL
  | "LAZY"        -> LAZY
  | "LBRACE"      -> LBRACE
  | "LBRACELESS"  -> LBRACELESS
  | "LBRACKET"    -> LBRACKET
  | "LBRACKETAT"  -> LBRACKETAT
  | "LBRACKETATAT"-> LBRACKETATAT
  | "LBRACKETATATAT" -> LBRACKETATATAT
  | "LBRACKETBAR"  -> LBRACKETBAR
  | "LBRACKETGREATER" -> LBRACKETGREATER
  | "LBRACKETLESS" -> LBRACKETLESS
  | "LBRACKETPERCENT" -> LBRACKETPERCENT
  | "LBRACKETPERCENTPERCENT" -> LBRACKETPERCENTPERCENT
  | "LESS"        -> LESS
  | "LESSMINUS"   -> LESSMINUS
  | "LET"         -> LET
  | "LETOP"       -> LETOP
  | "LIDENT"      -> LIDENT
  | "LPAREN"      -> LPAREN
  | "MATCH"       -> MATCH
  | "METHOD"      -> METHOD
  | "MINUS"       -> MINUS
  | "MINUSDOT"    -> MINUSDOT
  | "MINUSGREATER"-> MINUSGREATER
  | "MODULE"      -> MODULE
  | "MUTABLE"     -> MUTABLE
  | "NEW"         -> NEW
  | "NONREC"      -> NONREC
  | "OBJECT"      -> OBJECT
  | "OF"          -> OF
  | "OPEN"        -> OPEN
  | "OPTLABEL"    -> OPTLABEL
  | "OR"          -> OR
  | "PERCENT"     -> PERCENT
  | "PLUS"        -> PLUS
  | "PLUSDOT"     -> PLUSDOT
  | "PLUSEQ"      -> PLUSEQ
  | "PREFIXOP"    -> PREFIXOP
  | "PRIVATE"     -> PRIVATE
  | "QUESTION"    -> QUESTION
  | "QUOTE"       -> QUOTE
  | "RBRACE"      -> RBRACE
  | "RBRACKET"    -> RBRACKET
  | "REC"         -> REC
  | "RPAREN"      -> RPAREN
  | "SEMI"        -> SEMI
  | "SEMISEMI"    -> SEMISEMI
  | "SIG"         -> SIG
  | "STAR"        -> STAR
  | "STRING"      -> STRING
  | "STRUCT"      -> STRUCT
  | "THEN"        -> THEN
  | "TILDE"       -> TILDE
  | "TO"          -> TO
  | "TRUE"        -> TRUE
  | "TRY"         -> TRY
  | "TYPE"        -> TYPE
  | "UIDENT"      -> UIDENT
  | "UNDERSCORE"  -> UNDERSCORE
  | "VAL"         -> VAL
  | "VIRTUAL"     -> VIRTUAL
  | "WHEN"        -> WHEN
  | "WHILE"       -> WHILE
  | "WITH"        -> WITH
  | token -> failwith ("Unknown token: " ^ token)

module Stat = Menhir_stat.Recorder(Raw_parser.MenhirInterpreter)

let word_iter str =
  let pos = ref 0 in
  fun () ->
    let i = !pos in
    match String.index_from str i ' ' with
    | exception Not_found ->
      let len = String.length str in
      if i < len then
        (pos := len; Some (String.sub str i (len - i)))
      else
        None
    | j ->
      pos := j + 1;
      Some (String.sub str i (j - i))

let parse_line str =
  let f = word_iter str in
  match f () with
  | Some "interface:" -> Some (`Intf, f)
  | Some "implementation:" -> Some (`Impl, f)
  | Some str ->
    failwith ("Unexpected input " ^ str ^
              ", expecting \"interface:\" or \"implementation:\"")
  | None -> None

let parse entry words =
  let supplier () =
    let token = match words () with
      | Some tok -> token_of_string tok
      | None -> EOF
    in
    (token, Lexing.dummy_pos, Lexing.dummy_pos)
  in
  MenhirInterpreter.loop supplier (entry Lexing.dummy_pos)

let () =
  let rec aux () =
    match input_line stdin with
    | line ->
      begin match parse_line line with
        | Some (`Intf, words) -> parse Incremental.interface words
        | Some (`Impl, words) -> parse Incremental.implementation words
        | None -> ()
      end;
      aux ()
    | exception End_of_file ->
      ()
  in
  aux ()