/**
 * Stratego Bindings for parsing using SGLR.
 *
 * All parse functions fail if there is a parse error. The ATerm
 * representation of the parse error can be retreived separately using
 * get-parse-error.
 *
 * @author Martin Bravenboer
 */
module stratego/sglr/parse
imports
  libstratego-lib
  libstratego-xtc

/**
 * Parse a string to an AST.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  String -> AST 
 * @todo  Set the pt type to asfix2?
 */
strategies

  parse-string(|tbl) =
    parse-string(id|tbl)

  parse-string(|tbl, start-symbol) =
    parse-string(id | tbl, start-symbol)

  parse-string(|tbl, start-symbol, path) =
    parse-string(id | tbl, start-symbol, path)

  parse-string(on-parse-error | tbl) =
    parse-string(on-parse-error | tbl, None(), "string")

  parse-string(on-parse-error | tbl, start-symbol) =
    parse-string(on-parse-error | tbl, start-symbol, "string")

  parse-string(on-parse-error | tbl, start-symbol, path) =
    parse-string-pt(on-parse-error | tbl, start-symbol, path)
    ; implode-asfix

/**
 * Parse a string to a parse tree.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  String -> ParseTree 
 */
strategies

  parse-string-pt(|tbl) =
    parse-string-pt(id | tbl)

  parse-string-pt(|tbl, start-symbol) =
    parse-string-pt(id | tbl, start-symbol)

  parse-string-pt(|tbl, start-symbol, path) =
    parse-string-pt(id | tbl, start-symbol, path)

  parse-string-pt(on-parse-error | tbl) =
    parse-string-pt(on-parse-error | tbl, None(), "string")

  parse-string-pt(on-parse-error | tbl, start-symbol) =
    parse-string-pt(on-parse-error | tbl, start-symbol, "string")

  parse-string-pt(on-parse-error |tbl, start-symbol, path) =
    where(!tbl => ParseTable(internal-tbl))
    ; ?string
    ; prim("STRSGLR_parse_string_pt", on-parse-error | string, internal-tbl, start-symbol, path)

/**
 * Parse a stream to an AST.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  Stream -> AST 
 * @todo  Set the pt type to asfix2?
 */
strategies

  parse-stream(|tbl) =
    parse-stream(fail | tbl)

  parse-stream(|tbl, start-symbol) =
    parse-stream(fail | tbl, start-symbol)

  parse-stream(|tbl, start-symbol, path) =
    parse-stream(fail | tbl, start-symbol, path)

  parse-stream(on-parse-error |tbl) =
    parse-stream(on-parse-error | tbl, None(), "string")

  parse-stream(on-parse-error | tbl, start-symbol) =
    parse-stream(on-parse-error | tbl, start-symbol, "string")
    
  parse-stream(on-parse-error | tbl, start-symbol, path) =
    parse-stream-pt(on-parse-error | tbl, start-symbol, path)
    ; implode-asfix

/**
 * Parse a stream to a parse tree.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  Stream -> ParseTree 
 */
strategies

  parse-stream-pt(| tbl) =
    parse-stream-pt(id | tbl)

  parse-stream-pt(| tbl, start-symbol) =
    parse-stream-pt(id | tbl, start-symbol)

  parse-stream-pt(| tbl, start-symbol, path) =
    parse-stream-pt(id | tbl, start-symbol, path)

  parse-stream-pt(on-parse-error | tbl) =
    parse-stream-pt(on-parse-error | tbl, None(), "stream")

  parse-stream-pt(on-parse-error | tbl, start-symbol) =
    parse-stream-pt(on-parse-error | tbl, start-symbol, "stream")
    
  parse-stream-pt(on-parse-error | tbl, start-symbol, path) =
    where(!tbl => ParseTable(internal-tbl))
    ; ?Stream(stream)
    ; prim("STRSGLR_parse_stream_pt", on-parse-error | stream, internal-tbl, start-symbol, path)

/**
 * Parse a file to an AST.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  String -> AST
 * @todo Set the pt type to asfix2?
 */
strategies

  parse-file(|tbl) =
    parse-file(fail, fail | tbl)

  parse-file(|tbl, start-symbol) =
    parse-file(fail, fail | tbl, start-symbol)

  parse-file(|tbl, start-symbol, path) =
    parse-file(fail, fail | tbl, start-symbol, path)

  parse-file(on-open-error, on-parse-error | tbl) =
    ?path; parse-file(on-open-error, on-parse-error | tbl, None(), path)

  parse-file(on-open-error, on-parse-error | tbl, start-symbol) =
    ?path; parse-file(on-open-error, on-parse-error | tbl, start-symbol, path)

  parse-file(on-open-error, on-parse-error | tbl, start-symbol, path) =
    parse-file-pt(on-open-error, on-parse-error | tbl, start-symbol, path)
    ; implode-asfix
/**
 * Parse a file to a parse tree.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  String -> ParseTree 
 */
strategies

  parse-file-pt(|tbl) =
    parse-file-pt(fail, fail | tbl)

  parse-file-pt(|tbl, start-symbol) =
    parse-file-pt(fail, fail | tbl, start-symbol)
    
  parse-file-pt(|tbl, start-symbol, path) =
    parse-file-pt(fail, fail | tbl, start-symbol, path)

  parse-file-pt(on-open-error, on-parse-error | tbl) =
    ?path; parse-file-pt(on-open-error, on-parse-error | tbl, None(), path)

  parse-file-pt(on-open-error, on-parse-error | tbl, start-symbol) =
    ?path; parse-file-pt(on-open-error, on-parse-error | tbl, start-symbol, path)

  parse-file-pt(on-open-error, on-parse-error | tbl, start-symbol, path) =
    where(!tbl => ParseTable(internal-tbl))
    ; (<fopen> (<id>, "r") => stream <+ on-open-error; fail)
    ; finally(
        parse-stream-pt(on-parse-error | tbl, start-symbol, path)
      , <fclose> stream
      )
      
/**
 * Parse an XTC file to an AST.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  FILE -> AST
 * @todo Set the pt type to asfix2?
 */
strategies

  /**
   * @type  FILE -> AST
   */
  parse-xtc-file(|tbl) =
    parse-xtc-file(fail, fail | tbl)

  parse-xtc-file(|tbl, start-symbol) =
    parse-xtc-file(fail, fail | tbl, start-symbol)

  parse-xtc-file(|tbl, start-symbol, path) =
    parse-xtc-file(fail, fail | tbl, start-symbol, path)

  parse-xtc-file(on-open-error, on-parse-error | tbl) =
    ?file; parse-xtc-file(on-open-error, on-parse-error | tbl, None(), <path-of-xtc-file> file)

  parse-xtc-file(on-open-error, on-parse-error | tbl, start-symbol) =
    ?file; parse-xtc-file(on-open-error, on-parse-error | tbl, start-symbol, <path-of-xtc-file> file)

  parse-xtc-file(on-open-error, on-parse-error | tbl, start-symbol, path) =
    parse-xtc-file-pt(on-open-error, on-parse-error | tbl, start-symbol, path)
    ; implode-asfix

/**
 * Parse an XTC file to a parse tree.
 *
 * @param ParseTable
 * @param String or None
 * @param String
 * @type  FILE -> ParseTree 
 */
strategies

  parse-xtc-file-pt(|tbl) =
    ?file; parse-xtc-file-pt(fail, fail | tbl, None(), <path-of-xtc-file> file)

  parse-xtc-file-pt(|tbl, start-symbol) =
    ?file; parse-xtc-file-pt(fail, fail | tbl, start-symbol, <path-of-xtc-file> file)

  parse-xtc-file-pt(|tbl, start-symbol, path) =
    parse-xtc-file-pt(fail, fail |tbl, start-symbol, path)

  parse-xtc-file-pt(on-open-error, on-parse-error | tbl) =
    ?file; parse-xtc-file-pt(on-open-error, on-parse-error |tbl, None(), <path-of-xtc-file> file)

  parse-xtc-file-pt(on-open-error, on-parse-error |tbl, start-symbol) =
    ?file; parse-xtc-file-pt(on-open-error, on-parse-error |tbl, start-symbol, <path-of-xtc-file> file)

  parse-xtc-file-pt(on-open-error, on-parse-error |tbl, start-symbol, path) =
    where(!tbl => ParseTable(internal-tbl))
    
    ; let open-stream =
            ?FILE(<id>); (<fopen> (<id>, "r") <+ on-open-error)
            <+ ?stdin(); stdin-stream
            
       in open-stream => stream
          ; finally(
              parse-stream-pt(on-parse-error |tbl, start-symbol, path)
            , <fclose> stream
            )
      end
      
  path-of-xtc-file =
    ?FILE(<is-string>) + ?stdin(); !"stdin"

strategies

  /**
   * Returns the parser error from the last parse.
   *
   * Fails if the last parse did not fail.
   */
  get-parse-error =
    prim("STRSGLR_get_parse_error")

  /**
   * Clears the current parse error.
   *
   * The current parse error is cleared when parsing a new input, so
   * there is usually no reason to invoke this strategy.
   */
  clear-parse-error =
    prim("STRSGLR_clear_parse_error")

  /**
   * Succeeds if the current term is a parse tree.
   */
  is-parse-tree =
    ?t; prim("STRSGLR_is_parse_tree", t)