(*
 * \begin{doc}
 * \section{Higher-level IO functions}
 *
 * \subsection{Regular expressions}
 * \index{regular expressions}
 *
 * Many of the higher-level functions use regular expressions.
 * Regular expressions are defined by strings with syntax nearly identical
 * to \Cmd{awk}{1}.
 *
 * Strings may contain the following character constants.
 *
 * \begin{itemize}
 * \item \verb+\\+ : a literal backslash.
 * \item \verb+\a+ : the alert character \verb+^G+.
 * \item \verb+\b+ : the backspace character \verb+^H+.
 * \item \verb+\f+ : the formfeed character \verb+^L+.
 * \item \verb+\n+ : the newline character \verb+^J+.
 * \item \verb+\r+ : the carriage return character \verb+^M+.
 * \item \verb+\t+ : the tab character \verb+^I+.
 * \item \verb+\v+ : the vertical tab character.
 * \item \verb+\xhh...+ : the character represented by the string
 *   of hexadecimal digits \verb+h+.  All valid hexadecimal digits
 *   following the sequence are considered to be part of the sequence.
 * \item \verb+\ddd+ : the character represented by 1, 2, or 3 octal
 *   digits.
 * \end{itemize}
 *
 * Regular expressions are defined using the special characters \verb+.\^$[(){}*?++.
 *
 * \begin{itemize}
 * \item \verb+c+ : matches the literal character \verb+c+ if \verb+c+ is not
 *    a special character.
 * \item \verb+\c+ : matches the literal character \verb+c+, even if \verb+c+
 *    is a special character.
 * \item \verb+.+ : matches any character, including newline.
 * \item \verb+^+ : matches the beginning of a line.
 * \item \verb+$+ : matches the end of line.
 * \item \verb+[abc...]+ : matches any of the characters \verb+abc...+
 * \item \verb+[^abc...]+ : matches any character except \verb+abc...+
 * \item \verb+r1|r2+ : matches either \verb+r1+ or \verb+r2+.
 * \item \verb+r1r2+ : matches \verb+r1+ and then \verb+r2+.
 * \item \verb+r++ : matches one or more occurrences of \verb+r+.
 * \item \verb+r*+ : matches zero or more occurrences of \verb+r+.
 * \item \verb+r?+ : matches zero or one occurrence of \verb+r+.
 * \item \verb+(r)+ : parentheses are used for grouping; matches \verb+r+.
 * \item \verb+\(r\)+ : also defines grouping, but the expression matched
 *    within the parentheses is available to the output processor
 *    through one of the variables \verb+$1+, \verb+$2+, ...
 * \item \verb+r{n}+ : matches exactly \verb+n+ occurrences of \verb+r+.
 * \item \verb+r{n,}+ : matches \verb+n+ or more occurrences of \verb+r+.
 * \item \verb+r{n,m}+ : matches at least \verb+n+ occurrences of \verb+r+,
 *    and no more than \verb+m+ occurrences.
 * \item \verb+\y+: matches the empty string at either the beginning or
 *    end of a word.
 * \item \verb+\B+: matches the empty string within a word.
 * \item \verb+\<+: matches the empty string at the beginning of a word.
 * \item \verb+\>+: matches the empty string at the end of a word.
 * \item \verb+\w+: matches any character in a word.
 * \item \verb+\W+: matches any character that does not occur within a word.
 * \item \verb+\`+: matches the empty string at the beginning of a file.
 * \item \verb+\'+: matches the empty string at the end of a file.
 * \end{itemize}
 *
 * Character classes can be used to specify character sequences
 * abstractly.  Some of these sequences can change depending on your LOCALE.
 *
 * \begin{itemize}
 * \item \verb+[[:alnum:]]+ Alphanumeric characters.
 * \item \verb+[[:alpha:]]+ Alphabetic characters.
 * \item \verb+[[:lower:]]+ Lowercase alphabetic characters.
 * \item \verb+[[:upper:]]+ Uppercase alphabetic characters.
 * \item \verb+[[:cntrl:]]+ Control characters.
 * \item \verb+[[:digit:]]+ Numeric characters.
 * \item \verb+[[:xdigit:]]+ Numeric and hexadecimal characters.
 * \item \verb+[[:graph:]]+ Characters that are printable and visible.
 * \item \verb+[[:print:]]+ Characters that are printable, whether they are visible or not.
 * \item \verb+[[:punct:]]+ Punctuation characters.
 * \item \verb+[[:blank:]]+ Space or tab characters.
 * \item \verb+[[:space:]]+ Whitespace characters.
 * \end{itemize}
 * \end{doc}
 *
 *)


include Omake_pos.Make (struct let name = "Omake_builtin_io_fun" end)


let debug_parsing =
  Lm_debug.create_debug (**)
    { debug_name = "parsing";
      debug_description = "Debug parsing operations";
      debug_value = false
    }

(*
 * Concatenate files into a string.
 *
 * \begin{doc}
 * \fun{cat}
 *
 * \begin{verbatim}
 *     cat(files) : Sequence
 *        files : File or InChannel Sequence
 * \end{verbatim}
 *
 * The \verb+cat+ function concatenates the output from multiple files
 * and returns it as a string.
 * \end{doc}
 *)
let cat venv pos loc args =
  let pos = string_pos "cat" pos in
  match args with
    [arg] ->
    let names = Omake_value.values_of_value venv pos arg in
    let buf = Buffer.create 1024 in
    List.iter (fun name ->
      try
        let inp, close_flag = Omake_value.in_channel_of_any_value venv pos name in
        let inx = Omake_env.venv_find_channel venv pos inp in
        let rec copy () =
          let c = Lm_channel.input_char inx in
          Buffer.add_char buf c;
          copy ()
        in
        let () =
          try copy () with
            End_of_file ->
            ()
        in
        if close_flag then
          Omake_env.venv_close_channel venv pos inp
      with
        Sys_error _ ->
        let print_error buf =
          Format.fprintf buf "unable to open file: %a" Omake_value_print.pp_print_value name
        in
        raise (Omake_value_type.OmakeException (loc_pos loc pos, LazyError print_error))) names;
    Omake_value_type.ValString (Buffer.contents buf)
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * Grep takes some flags.
 *
 * \begin{doc}
 * \fun{grep}
 *
 * \begin{verbatim}
 *    grep(pattern) : String  # input from stdin, default options
 *       pattern : String
 *    grep(pattern, files) : String  # default options
 *       pattern : String
 *       files   : File Sequence
 *    grep(options, pattern, files) : String
 *      options : String
 *      pattern : String
 *      files   : File Sequence
 * \end{verbatim}
 *
 * The \verb+grep+ function searches for occurrences of a regular
 * expression \verb+pattern+ in a set of files, and prints lines that match.
 * This is like a highly-simplified version of \Cmd{grep}{1}.
 *
 * The options are:
 * \begin{description}
 * \item[q] If specified, the output from \verb+grep+ is not displayed.
 * \item[h] If specified, output lines will not include the filename (default, when only one input
 *          file is given).
 * \item[n] If specified, output lines include the filename (default, when more than one input file
 *          is given).
 * \item[v] If specified, search for lines without a match instead of lines with a match,
 * \end{description}
 *
 * The \verb+pattern+ is a regular expression.
 *
 * If successful (\verb+grep+ found a match), the function returns \verb+true+.
 * Otherwise, it returns \verb+false+.
 * \end{doc}
 *)
type grep_flag =
   GrepQuiet
 | GrepPrint
 | GrepNoPrint
 | GrepNoMatch

let grep_flags pos loc s =
   let len = String.length s in
   let rec collect flags i =
      if i = len then
         flags
      else
         let flag =
            match s.[i] with
               'q' ->
                  GrepQuiet
             | 'n' ->
                  GrepPrint
             | 'v' ->
                  GrepNoMatch
             | 'h' ->
                  GrepNoPrint
             | c ->
                  raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("illegal grep option", String.make 1 c)))
         in
            collect (flag::flags) (succ i)
   in
      collect [] 0

let grep venv pos loc args =
  let pos = string_pos "grep" pos in
  let outx = Omake_value.channel_of_var venv pos loc  Omake_var.stdout_var in
  let flags, pattern, files =
    match args with
      [pattern] ->
      Omake_value_type.ValNone, pattern, Omake_value_type.ValNone
    | [pattern; files] ->
      ValNone, pattern, files
    | [flags; pattern; files] ->
      flags, pattern, files
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (1, 3), List.length args)))
  in
  let flags = grep_flags pos loc (Omake_value.string_of_value venv pos flags) in
  let pattern = Omake_value.string_of_value venv pos pattern in
  let pattern =
    try Omake_lexer.lexer_of_string pattern
    with Failure err ->
      let msg = Lm_printf.sprintf "Mailformed regular expression '%s'" pattern in
      raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
  in
  let files = Omake_value.values_of_value venv pos files in
  let flags, files =
    match files with
      [] ->
      flags, [Omake_env.venv_find_var venv pos loc Omake_var.stdin_var]
    | [_] ->
      flags, files
    | _::_::_ ->
      (if List.mem GrepNoPrint flags then flags else GrepPrint :: flags), files
  in
  let verbose = not (List.mem GrepQuiet flags) in
  let print = List.mem GrepPrint flags in
  let matches = not (List.mem GrepNoMatch flags) in

  (* Grep against a single line *)
  let grep_line file found line =
    let b = (Omake_lexer.lexer_matches pattern line == matches) in
    if b && verbose then
      begin
        if print then
          begin
            Lm_channel.output_string outx file;
            Lm_channel.output_char outx ':'
          end;
        Lm_channel.output_string outx line;
        Lm_channel.output_char outx '\n'
      end;
    found || b
  in

  (* Open the file *)
  let grep_file found s =
    let filename = Omake_value.string_of_value venv pos s in
    let inp, close_flag = Omake_value.in_channel_of_any_value venv pos s in
    let inx = Omake_env.venv_find_channel venv pos inp in
    let rec search found =
      let text =
        try Some (Lm_channel.input_line inx) with
          End_of_file ->
          None
      in
      match text with
        Some line' ->
        search (grep_line filename found line')
      | None ->
        found
    in
    let found = search found in
    if close_flag then
      Omake_env.venv_close_channel venv pos inp;
    found
  in
  let b = List.fold_left grep_file false files in
  Lm_channel.flush outx;
  Omake_builtin_util.val_of_bool b

let builtin_grep venv pos loc args =
   let pos = string_pos "builtin-grep" pos in
   let args =
      match args with
         [arg] ->
            Omake_value.values_of_value venv pos arg
       | _ ->
            raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))
   in

   (* Eat options *)
   let flags, pattern, files =
      let rec collect flags args =
         match args with
            arg :: args ->
               (match Omake_value.string_of_value venv pos arg with
                   "-q" ->
                      collect ("q" ^ flags) args
                 | "-n" ->
                      collect ("n" ^ flags) args
                 | "-v" ->
                      collect ("v" ^ flags) args
                 | "-h" ->
                      collect ("h" ^ flags) args
                 | pattern ->
                      flags, pattern, args)
          | [] ->
               raise (Omake_value_type.OmakeException (loc_pos loc pos, StringError "no pattern specified"))
      in
         collect "" args
   in
      grep venv pos loc [ValData flags; ValData pattern; ValArray files]

(*
 * \begin{doc}
 * \fun{scan}
 *
 * \begin{verbatim}
 *    scan(input-files)
 *    case string1
 *       body1
 *    case string2
 *       body2
 *    ...
 *    default
 *       bodyd
 * \end{verbatim}
 *
 * The \verb+scan+ function provides input processing in command-line form.
 * The function takes file/filename arguments.  If called with no
 * arguments, the input is taken from \verb+stdin+. If arguments are provided,
 * each specifies an \verb+InChannel+, or the name of a file for input.
 * Output is always to \verb+stdout+.
 *
 * The \verb+scan+ function operates by reading the input one line at a time,
 * and processing it according to the following algorithm.
 *
 * For each line,
 * the record is first split into fields, and
 * the fields are bound to the variables \verb+$1, $2, ...+.  The variable
 * \verb+$0+ is defined to be the entire line, and \verb+$*+ is an array
 * of all the field values.  The \verb+$(NF)+ variable is defined to be the number
 * of fields.
 *
 * Next, a case expression is selected.  If \verb+string_i+ matches the token \verb+$1+,
 * then \verb+body_i+ is evaluated.  If the body ends in an \verb+export+, the state
 * is passed to the next clause.  Otherwise the value is discarded.
 *
 * For example, here is an \verb+scan+ function that acts as a simple command processor.
 *
 * \begin{verbatim}
 *     calc() =
 *        i = 0
 *        scan(script.in)
 *        case print
 *           println($i)
 *        case inc
 *           i = $(add $i, 1)
 *           export
 *        case dec
 *           i = $(sub $i, 1)
 *           export
 *        case addconst
 *           i = $(add $i, $2)
 *           export
 *        default
 *           eprintln($"Unknown command: $1")
 * \end{verbatim}
 *
 * The \verb+scan+ function also supports several options.
 *
 * \begin{verbatim}
 *     scan(options, files)
 *     ...
 * \end{verbatim}
 *
 * \begin{description}
 * \item[A] Parse each line as an argument list, where arguments
 *    may be quoted.  For example, the following line has three words,
 *    ``\verb+ls+'', ``\verb+-l+'', ``\verb+Program Files+''.
 *
 *    \begin{verbatim}
 *        ls -l "Program Files"
 *    \end{verbatim}
 * \item[O] Parse each line using white space as the separator, using the
 *    usual \OMake{} algorithm for string parsing.  This is the default.
 * \item[x] Once each line is split, reduce each word using the
 *    hex representation.  This is the usual hex representation used
 *    in URL specifiers, so the string ``Program Files'' may be
 *    alternately represented in the form Program%20Files or
 *    Program+Files.
 * \end{description}
 *
 * Note, if you want to redirect the output to a file, the easiest way is to
 * redefine the \verb+stdout+ variable.  The \verb+stdout+ variable is scoped the
 * same way as other variables, so this definition does not affect the meaning of
 * \verb+stdout+ outside the \verb+calc+ function.
 *
 * \begin{verbatim}
 *     calc() =
 *         stdout = $(fopen script.out, w)
 *         scan(script.in)
 *            ...
 *         close($(stdout))
 * \end{verbatim}
 * \end{doc}
 *)

(*
 * Scanner options.
 *)
type parse_option =
   ParseArgs
 | ParseWords

type rewrite_option =
   RewriteHex
 | RewriteNone

let scan_options _ pos loc options s =
   let len = String.length s in
   let rec collect ((poption, roption) as options) i =
      if i = len then
         options
      else
         let options =
            match s.[i] with
               'A' ->
                  ParseArgs, roption
             | 'O' ->
                  ParseWords, roption
             | 'x' ->
                  poption, RewriteHex
             | _ ->
                  raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("illegal option", s)))
         in
            collect options (succ i)
   in
      collect options 0

let scan_options venv pos loc options =
   List.fold_left (scan_options venv pos loc) (ParseWords, RewriteNone) 
    (Omake_value.strings_of_value venv pos options)

(*
 * The arguments.
 *)
let scan_args venv pos loc (args : Omake_value_type.t list) =
   let pos = string_pos "scan_args" pos in
   let cases, options, files =
     match args with
       | [ValCases cases] ->
           cases, Omake_value_type.ValNone, Omake_env.venv_find_var venv pos loc Omake_var.stdin_var
       | [ValCases cases; files] ->
           cases, ValNone, files
       | [ValCases cases; options; files] ->
           cases, options, files
       | (ValBody _) :: _ ->
           raise (Omake_value_type.OmakeException (loc_pos loc pos, SyntaxError("Unexpected body (bad indentation?)")))
       | [_]
       | [_; _]
       | [_; _; _] ->
           raise (Omake_value_type.OmakeException (loc_pos loc pos, SyntaxError("No cases")))
       | _ ->
           raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))
   in
   let poptions, roptions = scan_options venv pos loc options in
      cases, poptions, roptions, Omake_value.values_of_value venv pos files

(*
 * Awk the value.
 *)
let scan venv pos loc args _ =
  let pos = string_pos "scan" pos in
  let cases, token_mode, rewrite_mode, files = scan_args venv pos loc args in

  (* Get lexers for all the cases *)
  let cases, def =
    List.fold_left (fun (cases, def) (v, test, body, export) ->
      if Lm_symbol.eq v Omake_symbol.case_sym then
        let s = Omake_value.string_of_value venv pos test in
        let cases =
          Lm_symbol.SymbolTable.filter_add cases (Lm_symbol.add s) (fun b ->
            match b with
              Some _ ->
              raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("duplicate case", v)))
            | None ->
              body, export)
        in
        cases, def
      else if Lm_symbol.eq v Omake_symbol.default_sym then
        match def with
          Some _ ->
          raise (Omake_value_type.OmakeException (loc_pos loc pos, StringError "duplicate default case"))
        | None ->
          cases, Some (body, export)
      else
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("unknown case", v)))) (Lm_symbol.SymbolTable.empty, None) cases
  in

  (* Split a line into words *)
  let collect_words_argv line =
    let words =
      match token_mode with
        ParseArgs ->
        Lm_string_util.parse_args line
      | ParseWords ->
        Omake_value.strings_of_value venv pos (ValString line)
    in
    match rewrite_mode with
      RewriteHex ->
      List.map Lm_string_util.decode_hex_name words
    | RewriteNone ->
      words
  in

  (* Select a case and run it *)
  let eval_case venv words =
    let body =
      match words with
        command :: _ ->
        (try Some (Lm_symbol.SymbolTable.find cases (Lm_symbol.add command)) with
          Not_found ->
          def)
      | [] ->
        def
    in
    match body with
      Some (body, export) ->
      let venv_new, _ = Omake_eval.eval_sequence_exp venv pos body in
      Omake_env.add_exports venv venv_new pos export
    | None ->
      venv
  in

  (* Read the file a line at a time *)
  let rec line_loop venv inx =
    let text =
      try Some (Lm_channel.input_line inx) with
        End_of_file ->
        None
    in
    match text with
      Some line ->
      let words = collect_words_argv line in
      let venv = Omake_env.venv_add_match venv line words in
      let venv = eval_case venv words in
      line_loop venv inx
    | None ->
      venv
  in
  let rec file_loop venv args =
    match args with
      arg :: args ->
      let inp, close_in = Omake_value.in_channel_of_any_value venv pos arg in
      let inx = Omake_env.venv_find_channel venv pos inp in
      let venv =
        try line_loop venv inx with
          exn when close_in ->
          Omake_env.venv_close_channel venv pos inp;
          raise exn
      in
      if close_in then
        Omake_env.venv_close_channel venv pos inp;
      file_loop venv args
    | [] ->
      venv
  in
  file_loop venv files, Omake_value_type.ValNone

(*
 * \begin{doc}
 * \fun{awk}
 *
 * \begin{verbatim}
 *    awk(input-files)
 *    case pattern1:
 *       body1
 *    case pattern2:
 *       body2
 *    ...
 *    default:
 *       bodyd
 *\end{verbatim}
 *
 * or
 *
 * \begin{verbatim}
 *    awk(options, input-files)
 *    case pattern1:
 *       body1
 *    case pattern2:
 *       body2
 *    ...
 *    default:
 *       bodyd
 * \end{verbatim}
 *
 * The \verb+awk+ function provides input processing similar to \Cmd{awk}{1},
 * but more limited.  The \verb+input-files+ argument is a sequence of values,
 * each specifies an \verb+InChannel+, or the name of a file for input.
 * If called with no options and no file arguments, the input is taken from \verb+stdin+.
 * Output is always to \verb+stdout+.
 *
 * The variables \verb+RS+ and \verb+FS+ define record and field separators
 * as regular expressions.
 * The default value of \verb+RS+ is the regular expression \verb+\r|\n|\r\n+.
 * The default value of \verb+FS+ is the regular expression \verb+[ \t]++.
 *
 * The \verb+awk+ function operates by reading the input one record at a time,
 * and processing it according to the following algorithm.
 *
 * For each line,
 * the record is first split into fields using the field separator \verb+FS+, and
 * the fields are bound to the variables \verb+$1, $2, ...+.  The variable
 * \verb+$0+ is defined to be the entire line, and \verb+$*+ is an array
 * of all the field values.  The \verb+$(NF)+ variable is defined to be the number
 * of fields.
 *
 * Next, the cases are evaluated in order.
 * For each case, if the regular expression \verb+pattern_i+ matches the record \verb+$0+,
 * then \verb+body_i+ is evaluated.  If the body ends in an \verb+export+, the state
 * is passed to the next clause.  Otherwise the value is discarded.  If the regular
 * expression contains \verb+\(r\)+ expression, those expression override the
 * fields \verb+$1, $2, ...+.
 *
 * For example, here is an \verb+awk+ function to print the text between two
 * delimiters \verb+\begin{<name>}+ and \verb+\end{<name>}+, where the \verb+<name>+
 * must belong to a set passed as an argument to the \verb+filter+ function.
 *
 * \begin{verbatim}
 *     filter(names) =
 *        print = false
 *
 *        awk(Awk.in)
 *        case $"^\\end\{\([[:alpha:]]+\)\}"
 *           if $(mem $1, $(names))
 *              print = false
 *              export
 *           export
 *        default
 *           if $(print)
 *              println($0)
 *        case $"^\\begin\{\([[:alpha:]]+\)\}"
 *           print = $(mem $1, $(names))
 *           export
 * \end{verbatim}
 *
 * Note, if you want to redirect the output to a file, the easiest way is to
 * redefine the \verb+stdout+ variable.  The \verb+stdout+ variable is scoped the
 * same way as other variables, so this definition does not affect the meaning of
 * \verb+stdout+ outside the \verb+filter+ function.
 *
 * \begin{verbatim}
 *     filter(names) =
 *         stdout = $(fopen file.out, w)
 *         awk(Awk.in)
 *            ...
 *         close($(stdout))
 * \end{verbatim}
 *
 * Options.
 * \begin{description}
 * \item[b] ``Break'' when evaluating cases.  Only the first case that matches will be selected.
 * \end{description}
 *
 * The \hyperfun{break} can be used to abort the loop,
 * exiting the \verb+awk+ function immediately.
 * \end{doc}
 *)

(*
 * Evaluate all the cases that match.
 *)
let rec awk_eval_cases venv pos loc break line cases =
   match cases with
      (None, body, export) :: cases ->
         let venv_new, _ = Omake_eval.eval_sequence_exp venv pos body in
         let venv = Omake_env.add_exports venv venv_new pos export in
            if break then
               venv
            else
               awk_eval_cases venv pos loc break line cases
    | (Some lex, body, export) :: cases ->
         let channel = Lm_channel.of_string line in
         let venv, stop =
            match Omake_lexer.Lexer.search lex channel with
               Some (_, _, _, _, args) ->
                  let venv_new = Omake_env.venv_add_match_args venv args in
                  let venv_new, _ = Omake_eval.eval_sequence_exp venv_new pos body in
                  let venv = Omake_env.add_exports venv venv_new pos export in
                     venv, break
             | None ->
                  venv, false
         in
            if stop then
               venv
            else
               awk_eval_cases venv pos loc break line cases
    | [] ->
         venv

(*
 * The arguments.
 *)
let awk_args venv pos loc (args : Omake_value_type.t list) =
  let pos = string_pos "awk_args" pos in
  match args with
    | [ValCases cases] ->
        cases, [Omake_env.venv_find_var venv pos loc Omake_var.stdin_var]
    | [ValCases cases; files] ->
        cases, Omake_value.values_of_value venv pos files
    | (ValBody _) :: _ ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, SyntaxError("Unexpected body (bad indentation?)")))
    | [_]
    | [_; _] ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, SyntaxError("No cases")))
    | _ ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (1, 2), List.length args)))

let awk_option_args venv pos loc (args : Omake_value_type.t list) =
  let pos = string_pos "awk_args" pos in
  match args with
    | [ValCases cases] ->
        cases, "", [Omake_env.venv_find_var venv pos loc Omake_var.stdin_var]
    | [ValCases cases; files] ->
        cases, "", Omake_value.values_of_value venv pos files
    | [ValCases cases; options; files] ->
        cases, Omake_value.string_of_value venv pos options, Omake_value.values_of_value venv pos files
    | (ValBody _) :: _ ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, SyntaxError("Unexpected body (bad indentation?)")))
    | [_]
    | [_; _]
    | [_; _; _] ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, SyntaxError("No cases")))
    | _ ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (1, 3), List.length args)))

type awk_flag =
   AwkBreak

let awk_flags pos loc s =
   let len = String.length s in
   let rec collect flags i =
      if i = len then
         flags
      else
         let flag =
            match s.[i] with
               'b' ->
                  AwkBreak
             | c ->
                  raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("illegal awk option", String.make 1 c)))
         in
            collect (flag :: flags) (succ i)
   in
      collect [] 0

(*
 * Awk the value.
 *)
let awk venv pos loc args _ =
  let pos = string_pos "awk" pos in
  let cases, flags, files = awk_option_args venv pos loc args in
  let flags = awk_flags pos loc flags in
  let break = List.mem AwkBreak flags in

  (* Separator expressions *)
  let rs =
    try Omake_value.string_of_value venv pos (Omake_env.venv_find_var_exn venv Omake_var.rs_var) with
      Not_found ->
      "\r|\n|\r\n"
  in
  let fs =
    try Omake_value.string_of_value venv pos (Omake_env.venv_find_var_exn venv Omake_var.fs_var) with
      Not_found ->
      "[ \t]+"
  in
  let rs_lex =
    try Omake_lexer.lexer_of_string rs with
      Failure err ->
      let msg = Lm_printf.sprintf "Malformed regular expression '%s'" rs in
      raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
  in
  let fs_lex =
    try Omake_lexer.lexer_of_string fs with
      Failure err ->
      let msg = Lm_printf.sprintf "Malformed regular expression '%s'" fs in
      raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
  in

  (* Get lexers for all the cases *)
  let cases =
    List.map (fun (v, test, body, export) ->
      if Lm_symbol.eq v Omake_symbol.case_sym then
        let s = Omake_value.string_of_value venv pos test in
        let _, lex =
          try Omake_lexer.Lexer.add_clause Omake_lexer.Lexer.empty v s with
            Failure err ->
            let msg = Lm_printf.sprintf "Malformed regular expression '%s'" s in
            raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
        in
        Some lex, body, export
      else if Lm_symbol.eq v Omake_symbol.default_sym then
        None, body, export
      else
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("unknown case", v)))) cases
  in

  (* Split a line into words *)
  let collect_words line =
    let channel = Lm_channel.of_string line in
    let rec collect words =
      match Omake_lexer.Lexer.searchto fs_lex channel with
        Omake_lexer.Lexer.LexEOF ->
        List.rev words
      | Omake_lexer.Lexer.LexSkipped (_, skipped)
      | Omake_lexer.Lexer.LexMatched (_, _, skipped, _, _) ->
        collect (skipped :: words)
    in
    collect []
  in

  (* Read the file a line at a time *)
  let rec line_loop venv inx lineno =
    match Omake_lexer.Lexer.searchto rs_lex inx with
      Omake_lexer.Lexer.LexEOF ->
      venv
    | Omake_lexer.Lexer.LexSkipped (_, line)
    | Omake_lexer.Lexer.LexMatched (_, _, line, _, _) ->
      (* Split into words *)
      let words = collect_words line in
      let venv = Omake_env.venv_add_match venv line words in
      let venv = Omake_env.venv_add_var venv Omake_var.fnr_var (ValInt lineno) in
      let venv = awk_eval_cases venv pos loc break line cases in
      line_loop venv inx (lineno + 1)
  in
  let rec file_loop venv args =
    match args with
      arg :: args ->
      let inp, close_in = Omake_value.in_channel_of_any_value venv pos arg in
      let inx = Omake_env.venv_find_channel venv pos inp in
      let venv = Omake_env.venv_add_var venv Omake_var.filename_var (ValData (Lm_channel.name inx)) in
      let venv =
        try line_loop venv inx 1 with
          exn when close_in ->
          Omake_env.venv_close_channel venv pos inp;
          raise exn
      in
      if close_in then
        Omake_env.venv_close_channel venv pos inp;
      file_loop venv args
    | [] ->
      venv
  in
  let venv =
    try file_loop venv files with
      Omake_env.Break (_, venv) ->
      venv
  in
  venv, Omake_value_type.ValNone

(*
 * \begin{doc}
 * \fun{fsubst}
 *
 * \begin{verbatim}
 *    fsubst(files)
 *    case pattern1 [options]
 *       body1
 *    case pattern2 [options]
 *       body2
 *    ...
 *    default
 *       bodyd
 * \end{verbatim}
 *
 * The \verb+fsubst+ function provides a \Cmd{sed}{1}-like substitution
 * function.  Similar to \verb+awk+, if \verb+fsubst+ is called with no
 * arguments, the input is taken from \verb+stdin+.  If arguments are provided,
 * each specifies an \verb+InChannel+, or the name of a file for input.
 *
 * The \verb+RS+ variable defines a regular expression that determines a record separator,
 * The default value of \verb+RS+ is the regular expression \verb+\r|\n|\r\n+.
 *
 * The \verb+fsubst+ function reads the file one record at a time.
 *
 * For each record, the cases are evaluated in order.  Each case defines
 * a substitution from a substring matching the \verb+pattern+ to
 * replacement text defined by the body.
 *
 * Currently, there is only one option: \verb+g+.
 * If specified, each clause specifies a global replacement,
 * and all instances of the pattern define a substitution.
 * Otherwise, the substitution is applied only once.
 *
 * Output can be redirected by redefining the \verb+stdout+ variable.
 *
 * For example, the following program replaces all occurrences of
 * an expression \verb+word.+ with its capitalized form.
 *
 * \begin{verbatim}
 *     section
 *        stdout = $(fopen Subst.out, w)
 *        fsubst(Subst.in)
 *        case $"\<\([[:alnum:]]+\)\." g
 *           value $(capitalize $1).
 *        close($(stdout))
 * \end{verbatim}
 * \end{doc}
 *)

(*
 * Substitution options.
 *)
let subst_global_opt = 1

let subst_options _ pos loc options s =
   let len = String.length s in
   let rec collect options i =
      if i = len then
         options
      else
         let flag =
            match s.[i] with
               'g' ->
                  subst_global_opt
             | _ ->
                  raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError ("illegal option", s)))
         in
            collect (options lor flag) (succ i)
   in
      collect options 0

(*
 * Sed function performs a substitution line-by-line.
 *)
let rec subst_eval_case venv pos loc buf channel lex options body =
   match Omake_lexer.Lexer.searchto lex channel with
      Omake_lexer.Lexer.LexEOF ->
         ()
    | Omake_lexer.Lexer.LexSkipped (_, skipped) ->
         Buffer.add_string buf skipped
    | Omake_lexer.Lexer.LexMatched (_, _, skipped, matched, args) ->
         let venv' = Omake_env.venv_add_match venv matched args in
         let _, result = Omake_eval.eval_sequence_exp venv' pos body in
            Buffer.add_string buf skipped;
            Buffer.add_string buf (Omake_value.string_of_value venv pos result);
            if (options land subst_global_opt) <> 0 then
               subst_eval_case venv pos loc buf channel lex options body
            else
               Lm_channel.LexerInput.lex_buffer channel buf

let subst_eval_line venv pos loc line cases =
   let buffer = Buffer.create (String.length line) in
      List.fold_left (fun line (lex, options, body) ->
            let channel = Lm_channel.of_string line in
               Buffer.clear buffer;
               subst_eval_case venv pos loc buffer channel lex options body;
               Buffer.contents buffer) line cases

let fsubst venv pos loc args _ =
   let pos = string_pos "fsubst" pos in
   let cases, files = awk_args venv pos loc args in
   let outp = Omake_value.prim_channel_of_var venv pos loc Omake_var.stdout_var in
   let outx = Omake_env.venv_find_channel venv pos outp in

   (* Record separator *)
   let rs =
      try Omake_value.string_of_value venv pos (Omake_env.venv_find_var_exn venv Omake_var.rs_var) with
         Not_found ->
            "\r|\n|\r\n"
   in
   let rs_lex =
      try Omake_lexer.lexer_of_string rs with
         Failure err ->
            let msg = Lm_printf.sprintf "Malformed regular expression '%s'" rs in
               raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
   in

   (* Get lexers for all the cases *)
   let cases =
      List.map (fun (v, test, body, _) ->
            let args = Omake_value.values_of_value venv pos test in
            let pattern, options =
               match args with
                  pattern :: options ->
                     Omake_value.string_of_value venv pos pattern, options
                | [] ->
                     "", []
            in
            let pattern, options =
               if Lm_symbol.eq v Omake_symbol.case_sym then
                  pattern, options
               else if Lm_symbol.eq v Omake_symbol.default_sym then
                  ".*", []
               else
                  raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("unknown case", v)))
            in
            let options =
               List.fold_left (fun options arg ->
                     subst_options venv pos loc options (Omake_value.string_of_value venv pos arg)) 0 options
            in
            let _, lex =
               try Omake_lexer.Lexer.add_clause Omake_lexer.Lexer.empty v pattern with
                  Failure err ->
                     let msg = Lm_printf.sprintf "Malformed regular expression '%s'" pattern in
                        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
            in
               lex, options, body) cases
   in

   (* Read the file a line at a time *)
   let rec line_loop inx =
      match Omake_lexer.Lexer.searchto rs_lex inx with
         Omake_lexer.Lexer.LexEOF ->
            ()
       | Omake_lexer.Lexer.LexSkipped (_, line) ->
            let line = subst_eval_line venv pos loc line cases in
               Lm_channel.output_string outx line
       | Omake_lexer.Lexer.LexMatched (_, _, line, term, _) ->
            let line = subst_eval_line venv pos loc line cases in
               Lm_channel.output_string outx line;
               Lm_channel.output_string outx term;
               line_loop inx
   in
   let rec file_loop files =
      match files with
         file :: files ->
            let inp, close_in = Omake_value.in_channel_of_any_value venv pos file in
            let inx = Omake_env.venv_find_channel venv pos inp in
            let () =
               try line_loop inx with
                  exn when close_in ->
                     Omake_env.venv_close_channel venv pos inp;
                     raise exn
            in
               if close_in then
                  Omake_env.venv_close_channel venv pos inp;
               file_loop files
       | [] ->
            ()
   in
   let venv =
      try file_loop files; venv with
         Omake_env.Break (_, venv) ->
            venv
   in
      Lm_channel.flush outx;
      venv, Omake_value_type.ValNone

(*
 * \begin{doc}
 * \fun{lex}
 *
 * \begin{verbatim}
 *    lex(files)
 *    case pattern1
 *       body1
 *    case pattern2
 *       body2
 *    ...
 *    default
 *       bodyd
 * \end{verbatim}
 *
 * The \verb+lex+ function provides a simple lexical-style scanner
 * function.  The input is a sequence of files or channels.  The cases
 * specify regular expressions.  Each time the input is read, the regular
 * expression that matches the \emph{longest prefix} of the input is selected,
 * and the body is evaluated.
 *
 * If two clauses both match the same input, the \emph{last} one is selected
 * for execution.  The \verb+default+ case matches the regular expression \verb+.+;
 * you probably want to place it first in the pattern list.
 *
 * If the body end with an \verb+export+ directive,
 * the state is passed to the next clause.
 *
 * For example, the following program collects all occurrences of alphanumeric
 * words in an input file.
 *
 * \begin{verbatim}
 *     collect-words(files) =
 *        words[] =
 *        lex($(files))
 *        default
 *           # empty
 *        case $"[[:alnum:]]+" g
 *           words[] += $0
 *           export
 *        value $(words)
 * \end{verbatim}
 *
 * The \verb+default+ case, if one exists, matches single characters.  Since
 *
 * It is an error if the input does not match any of the regular expressions.
 *
 * The \hyperfun{break} can be used to abort the loop.
 * \end{doc}
 *)
let eof_sym = Lm_symbol.add "eof"

let lex venv pos loc args _ =
   let pos = string_pos "lex" pos in
   let cases, files = awk_args venv pos loc args in

   (* Add a clause for EOF *)
   let _, lex = Omake_lexer.Lexer.add_clause Omake_lexer.Lexer.empty eof_sym "\\'" in

   (* Get lexers for all the cases *)
   let lex, cases, _ =
      List.fold_left (fun (lex, cases, index) (v, test, body, export) ->
            let args = Omake_value.values_of_value venv pos test in
            let pattern =
               match args with
                  pattern :: _ ->
                     Omake_value.string_of_value venv pos pattern
                | [] ->
                     ""
            in
            let pattern =
               if Lm_symbol.eq v Omake_symbol.case_sym then
                  pattern
               else if Lm_symbol.eq v Omake_symbol.default_sym then
                  "."
               else
                  raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("unknown case", v)))
            in
               let action_sym = Lm_symbol.make "action" index in
               let _, lex =
                  try Omake_lexer.Lexer.add_clause lex action_sym pattern with
                     Failure err ->
                        let msg = Lm_printf.sprintf "Malformed regular expression '%s'" pattern in
                           raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
               in
               let cases = Lm_symbol.SymbolTable.add cases action_sym (body, export) in
                  lex, cases, succ index) (lex, Lm_symbol.SymbolTable.empty, 0) cases
   in

   (* Process the files *)
   let rec input_loop venv inx =
      let action_sym, lexeme_loc, lexeme, args = Omake_lexer.Lexer.lex lex inx in
         if Lm_symbol.eq action_sym eof_sym then
            venv
         else
            let venv_new = Omake_env.venv_add_match venv lexeme args in
            let venv_new = Omake_env.venv_add_var venv_new Omake_var.parse_loc_var (ValOther (ValLocation lexeme_loc)) in
            let body, export =
               try Lm_symbol.SymbolTable.find cases action_sym with
                  Not_found ->
                     raise (Invalid_argument "lex")
            in
            let venv_new, _ = Omake_eval.eval_sequence_exp venv_new pos body in
            let venv = Omake_env.add_exports venv venv_new pos export in
               input_loop venv inx
   in
   let rec file_loop venv files =
      match files with
         file :: files ->
            let inp, close_in = Omake_value.in_channel_of_any_value venv pos file in
            let inx = Omake_env.venv_find_channel venv pos inp in
            let venv =
               try input_loop venv inx with
                  (Omake_env.Break _ | Omake_value_type.Return _ ) as exn ->
                     if close_in then
                        Omake_env.venv_close_channel venv pos inp;
                     raise exn
                | exn ->
                     if close_in then
                        Omake_env.venv_close_channel venv pos inp;
                     Omake_eval.raise_uncaught_exception pos exn
            in
               if close_in then
                  Omake_env.venv_close_channel venv pos inp;
               file_loop venv files
       | [] ->
            venv
   in
   let venv =
      try file_loop venv files with
         Omake_env.Break (_, venv) ->
            venv
   in
      venv, Omake_value_type.ValNone

(*
 * \begin{doc}
 * \fun{lex-search}
 *
 * \begin{verbatim}
 *    lex-search(files)
 *    case pattern1
 *       body1
 *    case pattern2
 *       body2
 *    ...
 *    default
 *       bodyd
 * \end{verbatim}
 *
 * The \verb+lex-search+ function is like the \verb+lex+ function, but input that
 * does not match any of the regular expressions is skipped.  If the clauses include
 * a \verb+default+ case, then the \verb+default+ matches any skipped text.
 *
 * For example, the following program collects all occurrences of alphanumeric
 * words in an input file, skipping any other text.
 *
 * \begin{verbatim}
 *     collect-words($(files)) =
 *        words[] =
 *        lex-search($(files))
 *        default
 *           eprintln(Skipped $0)
 *        case $"[[:alnum:]]+" g
 *           words[] += $0
 *           export
 * \end{verbatim}
 *
 * The \verb+default+ case, if one exists, matches single characters.  Since
 *
 * It is an error if the input does not match any of the regular expressions.
 *
 * The \hyperfun{break} can be used to abort the loop.
 * \end{doc}
 *)
let lex_search venv pos loc args _ =
  let pos = string_pos "lex-search" pos in
  let cases, files = awk_args venv pos loc args in

  (* Get lexers for all the cases *)
  let lex, cases, default, _ =
    List.fold_left (fun (lex, cases, default, index) (v, test, body, export) ->
      let args = Omake_value.values_of_value venv pos test in
      let pattern =
        match args with
          pattern :: _ ->
          Omake_value.string_of_value venv pos pattern
        | [] ->
          ""
      in
      if Lm_symbol.eq v Omake_symbol.case_sym then
        let action_sym = Lm_symbol.make "action" index in
        let _, lex =
          try Omake_lexer.Lexer.add_clause lex action_sym pattern with
            Failure err ->
            let msg = Lm_printf.sprintf "Malformed regular expression '%s'" pattern in
            raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
        in
        let cases = Lm_symbol.SymbolTable.add cases action_sym (body, export) in
        lex, cases, default, succ index
      else if Lm_symbol.eq v Omake_symbol.default_sym then
        lex, cases, Some (body, export), index
      else
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("unknown case", v)))) (**)
      (Omake_lexer.Lexer.empty, Lm_symbol.SymbolTable.empty, None, 0) cases
  in

  (* What to do for skipped text *)
  let skip venv lexeme_loc lexeme =
    match lexeme, default with
      "", _
    | _, None ->
      venv
    | _, Some (body, export) ->
      let venv_new = Omake_env.venv_add_match venv lexeme [] in
      let venv_new = Omake_env.venv_add_var venv_new Omake_var.parse_loc_var (ValOther (ValLocation lexeme_loc)) in
      let venv_new, _ = Omake_eval.eval_sequence_exp venv_new pos body in
      Omake_env.add_exports venv venv_new pos export
  in

  (* Process the files *)
  let rec input_loop venv inx =
    match Omake_lexer.Lexer.searchto lex inx with
      Omake_lexer.Lexer.LexEOF ->
      venv
    | Omake_lexer.Lexer.LexSkipped (_, lexeme) ->
      skip venv loc lexeme
    | Omake_lexer.Lexer.LexMatched (action_sym, lexeme_loc, skipped, lexeme, args) ->
      (* Process skipped text *)
      let venv = skip venv lexeme_loc skipped in

      (* Process the matched text *)
      let venv_new = Omake_env.venv_add_match venv lexeme args in
      let venv_new = Omake_env.venv_add_var venv_new Omake_var.parse_loc_var (ValOther (ValLocation lexeme_loc)) in
      let body, export =
        try Lm_symbol.SymbolTable.find cases action_sym with
          Not_found ->
          raise (Invalid_argument "lex")
      in
      let venv_new, _ = Omake_eval.eval_sequence_exp venv_new pos body in
      let venv = Omake_env.add_exports venv venv_new pos export in
      input_loop venv inx
  in

  (* Process each file *)
  let rec file_loop venv files =
    match files with
      file :: files ->
      let inp, close_in = Omake_value.in_channel_of_any_value venv pos file in
      let inx = Omake_env.venv_find_channel venv pos inp in
      let venv =
        try input_loop venv inx with
          (Omake_env.Break _ | Omake_value_type.Return _) as exn ->
          if close_in then
            Omake_env.venv_close_channel venv pos inp;
          raise exn
        | exn ->
          if close_in then
            Omake_env.venv_close_channel venv pos inp;
          Omake_eval.raise_uncaught_exception pos exn
      in
      if close_in then
        Omake_env.venv_close_channel venv pos inp;
      file_loop venv files
    | [] ->
      venv
  in
  let venv =
    try file_loop venv files with
      Omake_env.Break (_, venv) ->
      venv
  in
  venv, Omake_value_type.ValNone

(*
 * \begin{doc}
 * \obj{Lexer}
 *
 * The \verb+Omake_lexer.Lexer+ object defines a facility for lexical analysis, similar to the
 * \Cmd{lex}{1} and \Cmd{flex}{1} programs.
 *
 * In \Prog{omake}, lexical analyzers can be constructed dynamically by extending
 * the \verb+Omake_lexer.Lexer+ class.  A lexer definition consists of a set of directives specified
 * with method calls,  and set of clauses specified as rules.
 *
 * For example, consider the following lexer definition, which is intended
 * for lexical analysis of simple arithmetic expressions for a desktop
 * calculator.
 *
 * \begin{verbatim}
 *    lexer1. =
 *       extends $(Omake_lexer.Lexer)
 *
 *       other: .
 *          eprintln(Illegal character: $* )
 *          lex()
 *
 *       white: $"[[:space:]]+"
 *          lex()
 *
 *       op: $"[-+*/()]"
 *          switch $*
 *          case +
 *             Token.unit($(loc), plus)
 *          case -
 *             Token.unit($(loc), minus)
 *          case *
 *             Token.unit($(loc), mul)
 *          case /
 *             Token.unit($(loc), div)
 *          case $"("
 *             Token.unit($(loc), lparen)
 *          case $")"
 *             Token.unit($(loc), rparen)
 *
 *       number: $"[[:digit:]]+"
 *          Token.pair($(loc), exp, $(int $* ))
 *
 *       eof: $"\'"
 *          Token.unit($(loc), eof)
 * \end{verbatim}
 *
 * This program defines an object \verb+lexer1+ the extends the \verb+Omake_lexer.Lexer+
 * object, which defines lexing environment.
 *
 * The remainder of the definition consists of a set of clauses,
 * each with a method name before the colon; a regular expression
 * after the colon; and in this case, a body.  The body is optional,
 * if it is not specified, the method with the given name should
 * already exist in the lexer definition.
 *
 * \emph{NB} The clause that matches the \emph{longest} prefix of the input
 * is selected.  If two clauses match the same input prefix, then the \emph{last}
 * one is selected.  This is unlike most standard lexers, but makes more sense
 * for extensible grammars.
 *
 * The first clause matches any input that is not matched by the other clauses.
 * In this case, an error message is printed for any unknown character, and
 * the input is skipped.  Note that this clause is selected only if no other
 * clause matches.
 *
 * The second clause is responsible for ignoring white space.
 * If whitespace is found, it is ignored, and the lexer is called
 * recursively.
 *
 * The third clause is responsible for the arithmetic operators.
 * It makes use of the \verb+Token+ object, which defines three
 * fields: a \verb+loc+ field that represents the source location;
 * a \verb+name+; and a \verb+value+.
 *
 * The lexer defines the \verb+loc+ variable to be the location
 * of the current lexeme in each of the method bodies, so we can use
 * that value to create the tokens.
 *
 * The \verb+Token.unit($(loc), name)+
 * method constructs a new \verb+Token+ object with the given name,
 * and a default value.
 *
 * The \verb+number+ clause matches nonnegative integer constants.
 * The \verb+Token.pair($(loc), name, value)+ constructs a token with the
 * given name and value.
 *
 * \verb+Omake_lexer.Lexer+ object operate on \verb+InChannel+ objects.
 * The method \verb+lexer1.lex-channel(channel)+ reads the next
 * token from the channel argument.
 *
 * \subsection{Omake\textunderscore{}lexer.Lexer matching}
 *
 * During lexical analysis, clauses are selected by longest match.
 * That is, the clause that matches the longest sequence of input
 * characters is chosen for evaluation.  If no clause matches, the
 * lexer raises a \verb+RuntimeException+.  If more than one clause
 * matches the same amount of input, the first one is chosen
 * for evaluation.
 *
 * \subsection{Extending lexer definitions}
 *
 * Suppose we wish to augment the lexer example so that it ignores
 * comments.  We will define comments as any text that begins with
 * the string \verb+(*+, ends with \verb+*)+, and comments may
 * be nested.
 *
 * One convenient way to do this is to define a separate lexer
 * just to skip comments.
 *
 * \begin{verbatim}
 *    lex-comment. =
 *       extends $(Omake_lexer.Lexer)
 *
 *       level = 0
 *
 *       other: .
 *          lex()
 *
 *       term: $"[*][)]"
 *          if $(not $(eq $(level), 0))
 *             level = $(sub $(level), 1)
 *             lex()
 *
 *       next: $"[(][*]"
 *          level = $(add $(level), 1)
 *          lex()
 *
 *       eof: $"\'"
 *          eprintln(Unterminated comment)
 * \end{verbatim}
 *
 * This lexer contains a field \verb+level+ that keeps track of the nesting
 * level.  On encountering a \verb+(*+ string, it increments the level,
 * and for \verb+*)+, it decrements the level if nonzero, and continues.
 *
 * Next, we need to modify our previous lexer to skip comments.
 * We can do this by extending the lexer object \verb+lexer1+
 * that we just created.
 *
 * \begin{verbatim}
 *    lexer1. +=
 *       comment: $"[(][*]"
 *          lex-comment.lex-channel($(channel))
 *          lex()
 * \end{verbatim}
 *
 * The body for the comment clause calls the \verb+lex-comment+ lexer when
 * a comment is encountered, and continues lexing when that lexer returns.
 *
 * \subsection{Threading the lexer object}
 *
 * Clause bodies may also end with an \verb+export+ directive.  In this case
 * the lexer object itself is used as the returned token.  If used with
 * the \verb+Parser+ object below, the lexer should define the \verb+loc+, \verb+name+
 * and \verb+value+ fields in each \verb+export+ clause.  Each time
 * the \verb+Parser+ calls the lexer, it calls it with the lexer returned
 * from the previous lex invocation.
 * \end{doc}
 *)

(*
 * Add a lexer clause.
 *)
let lex_rule venv pos loc (args : Omake_value_type.t list) kargs =
  let pos = string_pos "lex-rule" pos in
  match args, kargs with
    [_; action; _; pattern; _; ValBody (_, [], [], body, export)], [] ->
    let lexer = Omake_value.current_lexer venv pos in
    let action_name = Omake_value.string_of_value venv pos action in
    let action_sym = Lm_symbol.add action_name in
    let pattern = Omake_value.string_of_value venv pos pattern in
    let _, lexer =
      try Omake_lexer.Lexer.add_clause lexer action_sym pattern with
        Failure err ->
        let msg = Lm_printf.sprintf "Malformed regular expression '%s'" pattern in
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringStringError (msg, err)))
    in

    (* Add the method *)
    let action_var = Omake_ir.VarThis (loc, action_sym) in
    let venv = Omake_env.venv_add_var venv action_var (ValFun (Omake_env.venv_get_env venv, [], [], body, export)) in
    let venv = Omake_env.venv_add_var venv Omake_var.builtin_field_var (ValOther (ValLexer lexer)) in
    venv, Omake_value_type.ValNone

  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 6, List.length args)))

(*
 * Perform the lexing.
 *)
let lex_engine venv pos loc args kargs =
  let pos = string_pos "lex" pos in
  match args, kargs with
    [arg], [] ->
    let lexer = Omake_value.current_lexer venv pos in
    let inp, close_flag = Omake_value.in_channel_of_any_value venv pos arg in
    let inx = Omake_env.venv_find_channel venv pos inp in
    let action, lexeme_loc, lexeme, args =
      try Omake_lexer.Lexer.lex lexer inx with
        Failure _ as exn ->
        let loc = Lm_channel.loc inx in
        let pos = loc_pos loc pos in
        if close_flag then
          Omake_env.venv_close_channel venv pos inp;
        raise (Omake_value_type.UncaughtException (pos, exn))
    in
    let () =
      if close_flag then
        Omake_env.venv_close_channel venv pos inp
    in
    let venv = Omake_env.venv_add_match venv lexeme args in
    let venv = Omake_env.venv_add_var venv Omake_var.parse_loc_var (ValOther (ValLocation lexeme_loc)) in
    let action = Omake_env.venv_find_var venv pos loc (Omake_ir.VarThis (loc, action)) in
    Omake_eval.eval_apply venv pos loc action [] []
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * \begin{doc}
 * \obj{Parser}
 *
 * The \verb+Parser+ object provides a facility for syntactic analysis based
 * on context-free grammars.
 *
 * \verb+Parser+ objects are specified as a sequence of directives,
 * specified with method calls; and productions, specified as rules.
 *
 * For example, let's finish building the desktop calculator started
 * in the \verb+Lexer+ example.
 *
 * \begin{verbatim}
 *    parser1. =
 *       extends $(Parser)
 *
 *       #
 *       # Use the main lexer
 *       #
 *       lexer = $(lexer1)
 *
 *       #
 *       # Precedences, in ascending order
 *       #
 *       left(plus minus)
 *       left(mul div)
 *       right(uminus)
 *
 *       #
 *       # A program
 *       #
 *       start(prog)
 *
 *       prog: exp eof
 *          return $1
 *
 *       #
 *       # Simple arithmetic expressions
 *       #
 *       exp: minus exp :prec: uminus
 *          neg($2)
 *
 *       exp: exp plus exp
 *          add($1, $3)
 *
 *       exp: exp minus exp
 *          sub($1, $3)
 *
 *       exp: exp mul exp
 *          mul($1, $3)
 *
 *       exp: exp div exp
 *          div($1, $3)
 *
 *       exp: lparen exp rparen
 *          return $2
 * \end{verbatim}
 *
 * Parsers are defined as extensions of the \verb+Parser+ class.
 * A \verb+Parser+ object must have a \verb+lexer+ field.  The \verb+lexer+
 * is not required to be a \verb+Lexer+ object, but it must provide
 * a \verb+lexer.lex()+ method that returns a token object with
 * \verb+name+ and \verb+value+ fields.  For this example, we use the
 * \verb+lexer1+ object that we defined previously.
 *
 * The next step is to define precedences for the terminal symbols.
 * The precedences are defined with the \verb+left+, \verb+right+,
 * and \verb+nonassoc+ methods in order of increasing precedence.
 *
 * The grammar must have at least one start symbol, declared with
 * the \verb+start+ method.
 *
 * Next, the productions in the grammar are listed as rules.
 * The name of the production is listed before the colon, and
 * a sequence of variables is listed to the right of the colon.
 * The body is a semantic action to be evaluated when the production
 * is recognized as part of the input.
 *
 * In this example, these are the productions for the arithmetic
 * expressions recognized by the desktop calculator.  The semantic
 * action performs the calculation.  The variables \verb+$1, $2, ...+
 * correspond to the values associated with each of the variables
 * on the right-hand-side of the production.
 *
 * \subsection{Calling the parser}
 *
 * The parser is called with the \verb+$(parser1.parse-channel start, channel)+
 * or \verb+$(parser1.parse-file start, file)+ functions.  The \verb+start+
 * argument is the start symbol, and the \verb+channel+ or \verb+file+
 * is the input to the parser.
 *
 * \subsection{Parsing control}
 *
 * The parser generator generates a pushdown automation based on LALR(1)
 * tables.  As usual, if the grammar is ambiguous, this may generate shift/reduce
 * or reduce/reduce conflicts.  These conflicts are printed to standard
 * output when the automaton is generated.
 *
 * By default, the automaton is not constructed until the parser is
 * first used.
 *
 * The \verb+build(debug)+ method forces the construction of the automaton.
 * While not required, it is wise to finish each complete parser with
 * a call to the \verb+build(debug)+ method.  If the \verb+debug+ variable
 * is set, this also prints with parser table together with any conflicts.
 *
 * The \verb+loc+ variable is defined within action bodies, and represents
 * the input range for all tokens on the right-hand-side of the production.
 *
 * \subsection{Extending parsers}
 *
 * Parsers may also be extended by inheritance.
 * For example, let's extend the grammar so that it also recognizes
 * the \verb+<<+ and \verb+>>+ shift operations.
 *
 * First, we extend the lexer so that it recognizes these tokens.
 * This time, we choose to leave \verb+lexer1+ intact, instead of
 * using the += operator.
 *
 * \begin{verbatim}
 *    lexer2. =
 *       extends $(lexer1)
 *
 *       lsl: $"<<"
 *          Token.unit($(loc), lsl)
 *
 *       asr: $">>"
 *          Token.unit($(loc), asr)
 * \end{verbatim}
 *
 * Next, we extend the parser to handle these new operators.
 * We intend that the bitwise operators have lower precedence
 * than the other arithmetic operators.  The two-argument form
 * of the \verb+left+ method accomplishes this.
 *
 * \begin{verbatim}
 *    parser2. =
 *       extends $(parser1)
 *
 *       left(plus, lsl lsr asr)
 *
 *       lexer = $(lexer2)
 *
 *       exp: exp lsl exp
 *          lsl($1, $3)
 *
 *       exp: exp asr exp
 *          asr($1, $3)
 * \end{verbatim}
 *
 * In this case, we use the new lexer \verb+lexer2+, and we add productions
 * for the new shift operations.
 * \end{doc}
 *)

(*
 * Add start symbols.
 *)
let parse_start venv pos loc args kargs =
  let pos = string_pos "parse-start" pos in
  let parse = Omake_value.current_parser venv pos in
  let args =
    match args, kargs with
      [arg], [] ->
      Omake_value.strings_of_value venv pos arg
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))
  in
  let parse =
    List.fold_left (fun parse s ->
      Omake_parser.Parser.add_start parse (Lm_symbol.add s)) parse args in
  (* Redefine the parser *)
  let venv = Omake_env.venv_add_var venv Omake_var.builtin_field_var (ValOther (ValParser parse)) in
  venv, Omake_value_type.ValNone

(*
 * Precedence operations.
 *)
let parse_prec venv pos loc args kargs assoc =
  let pos = string_pos "parse-prec" pos in
  let this = Omake_env.venv_this venv in
  let parse = Omake_value.current_parser venv pos in
  let parse, level, args =
    match args, kargs with
      [before; args], [] ->
      let current_prec = Lm_symbol.add (Omake_value.string_of_value venv pos before) in
      let level =
        try Omake_parser.Parser.find_prec parse current_prec with
          Not_found ->
          raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("no such precedence", current_prec)))
      in
      let parse, level = Omake_parser.Parser.create_prec_lt parse level assoc in
      parse, level, args
    | [args], [] ->
      let current_prec = Lm_symbol.add (Omake_value.string_of_value venv pos (Omake_env.venv_find_field_internal this pos Omake_symbol.current_prec_sym)) in
      let level =
        try Omake_parser.Parser.find_prec parse current_prec with
          Not_found ->
          raise (Omake_value_type.OmakeException (loc_pos loc pos, StringVarError ("current precedence is not found", current_prec)))
      in
      let parse, level = Omake_parser.Parser.create_prec_gt parse level assoc in
      parse, level, args
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityRange (1, 2), List.length args)))
  in
  let args = Omake_value.strings_of_value venv pos args in
  let parse =
    List.fold_left (fun parse s ->
      Omake_parser.Parser.add_prec parse level (Lm_symbol.add s)) parse args
  in

  (* Reset the current precedence *)
  let venv =
    match args with
      arg :: _ ->
      Omake_env.venv_add_var venv Omake_var.current_prec_field_var (ValString arg)
    | [] ->
      venv
  in

  (* Redefine the parser *)
  let venv = Omake_env.venv_add_var venv Omake_var.builtin_field_var (ValOther (ValParser parse)) in
  venv, Omake_value_type.ValNone

let parse_left venv pos loc args kargs =
   let pos = string_pos "parse-left" pos in
      parse_prec venv pos loc args kargs LeftAssoc

let parse_right venv pos loc args kargs =
   let pos = string_pos "parse-right" pos in
      parse_prec venv pos loc args kargs RightAssoc

let parse_nonassoc venv pos loc args kargs =
   let pos = string_pos "parse-nonassoc" pos in
      parse_prec venv pos loc args kargs NonAssoc

(*
 * Build the parser.
 *)
let parse_build venv pos loc args =
  let pos = string_pos "parse-build" pos in
  match args with
    [arg] ->
    let par = Omake_value.current_parser venv pos in
    let debug = Omake_value.bool_of_value venv pos arg in
    Omake_parser.Parser.build par debug;
    Omake_value_type.ValNone
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 1, List.length args)))

(*
 * Get the precedence option.
 *)
let prec_option venv pos _ options =
   Omake_env.venv_map_fold (fun _ optname optval ->
         let s = Omake_value.string_of_value venv pos optname in
            if s = ":prec:" then
               Some (Lm_symbol.add (Omake_value.string_of_value venv pos optval))
            else
               raise (Omake_value_type.OmakeException (pos, StringValueError ("illegal option", optname)))) None options

(*
 * Compute an action name that is not defined in the current object.
 *)
let action_sym = Lm_symbol.add "action"

let find_action_name venv loc =
   Lm_symbol.new_name action_sym (fun v -> Omake_env.venv_defined venv (Omake_ir.VarThis (loc, v)))

(*
 * Add a parser clause.
 *)
let parse_rule venv pos loc (args : Omake_value_type.t list) kargs =
  let pos = string_pos "parse-rule" pos in
  let action, head, rhs, options, body, export =
    match args, kargs with
      [_; action; head; rhs; ValMap options; ValBody (_, [], [], body, export)], [] ->
      let action = Omake_value.string_of_value venv pos action in
      let head = Omake_value.string_of_value venv pos head in
      if head = "" then   (* Action name was omitted *)
        find_action_name venv loc, Lm_symbol.add action, rhs, options, body, export
      else
        Lm_symbol.add action, Lm_symbol.add head, rhs, options, body, export
    | _ ->
      raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 6, List.length args)))
  in
  let par = Omake_value.current_parser venv pos in
  let rhs = List.map Lm_symbol.add (Omake_value.strings_of_value venv pos rhs) in
  let pre = prec_option venv pos loc options in
  let par = Omake_parser.Parser.add_production par action head rhs pre in

  (* Add the method if there is a body *)
  let venv =
    match body with
      _ :: _ ->
      let body : Omake_ir.exp list =
        LetVarExp (loc, Omake_ir.VarThis (loc, Omake_symbol.val_sym), [], VarDefNormal, ConstString (loc, "")) :: body
      in
      Omake_env.venv_add_var venv (Omake_ir.VarThis (loc, action)) (ValFun (Omake_env.venv_get_env venv, [], [], body, export))
    | [] ->
      venv
  in

  (* Add back the parser *)
  let venv = Omake_env.venv_add_var venv Omake_var.builtin_field_var (ValOther (ValParser par)) in
  venv, Omake_value_type.ValNone

(*
 * Perform the lexing.
 *)
let parse_engine venv pos loc args =
  let pos = string_pos "parse-engine" pos in
  match args with
    [start] ->
    let dfa = Omake_value.current_parser venv pos in
    let start = Lm_symbol.add (Omake_value.string_of_value venv pos start) in
    let lexer = Omake_env.venv_find_var venv pos loc Omake_var.lexer_field_var in
    let lexer = Omake_eval.eval_object venv pos lexer in
    let parser_obj = Omake_env.venv_this venv in
    let lex (venv, parser_obj, lexer) =
      let lex = Omake_env.venv_find_field_internal lexer pos Omake_symbol.lex_sym in
      let venv = Omake_env.venv_with_object venv lexer in
      let venv, result = Omake_eval.eval_apply venv pos loc lex [] [] in
      let obj = Omake_eval.eval_object venv pos result in
      try
        let lex_loc = Omake_env.venv_find_field_internal_exn obj Omake_symbol.loc_sym in
        let lex_loc = Omake_value.loc_of_value venv pos lex_loc in
        let name = Omake_env.venv_find_field_internal_exn obj Omake_symbol.name_sym in
        let name = Lm_symbol.add (Omake_value.string_of_value venv pos name) in
        let value = Omake_env.venv_find_field_internal_exn obj Omake_symbol.val_sym in
        name, lex_loc, (venv, parser_obj, lexer), value
      with
        Not_found ->
        let print_error buf =
          Format.fprintf buf "@[<v 3>The lexer returned a malformed object.\
                              @ @[<v 3>The result of a lexer action should be an object with at least 3 fields:\
                              @ loc: the location of the token\
                              @ name: the name of the token\
                              @ val: the value of the token@]\
                              @ %a@]" Omake_value_print.pp_print_value (ValObject obj)
        in
        raise (Omake_value_type.OmakeException (pos, LazyError print_error))
    in
    let eval (venv, parser_obj, lexer) action loc args =
      let pos = loc_pos loc pos in
      let venv = Omake_env.venv_add_match_values venv args in
      let action = Omake_env.venv_find_field_internal parser_obj pos action in
      let venv = Omake_env.venv_with_object venv parser_obj in
      let venv = Omake_env.venv_add_var venv Omake_var.parse_loc_var (ValOther (ValLocation loc)) in
      let venv, result = Omake_eval.eval_apply venv pos loc action [] [] in
      (venv, parser_obj, lexer), result
    in
    let _, value =
      try Omake_parser.Parser.parse dfa start lex eval (venv, parser_obj, lexer) with
        Failure _ as exn ->
        raise (Omake_value_type.UncaughtException (pos, exn))
      | Lm_parser.ParseError (loc, s) ->
        raise (Omake_value_type.OmakeException (loc_pos loc pos, StringError s))
    in
    value
  | _ ->
    raise (Omake_value_type.OmakeException (loc_pos loc pos, ArityMismatch (ArityExact 2, List.length args)))

(************************************************************************
 * External interface.
*)
let () =
  let builtin_funs =
    [true, "grep",                  grep,                 Omake_ir.ArityRange (1, 3);
     true, "builtin-grep",          builtin_grep,         ArityExact 1;
     true, "cat",                   cat,                  ArityExact 1;
     true, "parse-engine",          parse_engine,         ArityExact 1;
     true, "parse-build",           parse_build,          ArityExact 1;
    ]
  in
  let builtin_kfuns =
    [true, "lex-rule",              lex_rule,             Omake_ir.ArityRange (3, 4);
     true, "lex-engine",            lex_engine,           ArityExact 1;
     true, "parse-rule",            parse_rule,           ArityRange (3, 5);
     true, "parse-start",           parse_start,          ArityExact 1;
     true, "parse-left",            parse_left,           ArityExact 1;
     true, "parse-right",           parse_right,          ArityExact 1;
     true, "parse-nonassoc",        parse_nonassoc,       ArityExact 1;
     true, "scan",                  scan,                 ArityRange (1, 3);
     true, "awk",                   awk,                  ArityExact 3;
     true, "fsubst",                fsubst,               ArityExact 3;
     true, "lex",                   lex,                  ArityExact 3;
     true, "lex-search",            lex_search,           ArityExact 3;
    ]
  in
  let builtin_info =
    {Omake_builtin_type.builtin_empty with builtin_funs = builtin_funs;
      builtin_kfuns = builtin_kfuns
    }
  in
  Omake_builtin.register_builtin builtin_info
