<commit_before>Module: %coil
Synopsis: Ad-hoc recursive descent parser for coil configs
Author: <NAME>
Copyright: Copyright (c) 2013 <NAME>.  All rights reserved.
License:   See LICENSE.txt in this distribution for details.

/*

This parser makes two passes.  During the first pass objects that
don't involve any links outside the struct are parsed, and most
struct keys are filled in.  The second pass resolves @extends,
@file, deletions, compound struct keys (i.e., a.b.c: foo) and
struct value links (i.e., foo: a.b.c).  This is necessary because
@extends and @file may change what a.b.c refers to.

During the first pass, keys begining with '@' are used as placeholders
for items that need to be resolved during the second pass.  This works
because '@' isn't a valid character in coil struct keys.

A basic rule is that structs must be parsed in textual order.  Structs
that appear in the source file textually before other structs should
be fully parsed before those that appear later.  e.g., if a struct has
both "x: y" and "~x" then the "winner" is whichever one appears last.

TODO:
+ What are the intended semantics when a struct has both x and ~x?

+ Keep track of the source location of items that are resolved during
  the second pass, for better error messages.

*/

define constant $whitespace :: <string>
  = " \t\n\r";

define constant $token-terminators :: <string>
  = concatenate($whitespace, "}]\"");

define constant $key-regex :: <regex>
  = compile-regex("-*[a-zA-Z_][\\w-]*");

define constant $extended-key-regex :: <regex>
  = compile-regex(format-to-string("%s(\\.%s)*",
                                   $key-regex.regex-pattern,
                                   $key-regex.regex-pattern));

define constant $path-regex :: <regex>
  = compile-regex(format-to-string("(@|\\.+)?%s(\\.%s)*",
                                   $key-regex.regex-pattern,
                                   $key-regex.regex-pattern));


/// Synopsis: '$none' is what "None" parses to.
///
define class <none> (<object>) end;
define constant $none :: <none> = make(<none>);

define class <coil-parser> (<object>)
  constant slot source-locator :: false-or(<file-locator>) = #f,
    init-keyword: source:;

  // Text is the entire original coil source text.
  constant slot input-text :: <string> = "", required-init-keyword: text:;

  // Index points to the next character to be read by "consume".
  slot current-index :: <integer> = 0;

  // Line and column are for error reporting.  They are maintained by "consume".
  slot line-number :: <integer> = 1, init-keyword: line:;
  slot column-number :: <integer> = 1, init-keyword: column:;
end class <coil-parser>;


/// Synopsis: Any error signalled during parsing (except for file
///           system errors) will be an instance of this.
define class <coil-parse-error> (<coil-error>)
end;


/// Synopsis: Signal <coil-parse-error> with the given 'format-string' and
///           'args' as the message.  If the current source location is known
///           it is prefixed to the message.
define method parse-error
    (p :: <coil-parser>, format-string, #rest args)
  let context = format-to-string("@%d:%d ", p.line-number, p.column-number);
  let message = concatenate(context,
                            apply(format-to-string, format-string, args),
                            "\n", p.current-line,
                            "\n", p.indicator-line);
  error(make(<coil-parse-error>, format-string: message));
end;

/// Synopsis: Return the line pointed to by 'current-index'.
///
define method current-line
    (p :: <coil-parser>) => (line :: <string>)
  let max = p.input-text.size;
  let curr = p.current-index;
  let epos = min(position(p.input-text, '\n', start: curr) | max,
                 position(p.input-text, '\r', start: curr) | max);
  slice(p.input-text,
        p.current-index - p.column-number + 1,
        epos)
end;

/// Synopsis: Return a line that indicates which character 'current-index'
///           points to.  ".........^"
define method indicator-line
    (p :: <coil-parser>) => (line :: <string>)
  let line = make(<string>, size: p.column-number, fill: '.');
  line[p.column-number - 1] := '^';
  line
end;

/// Synopsis: Parse coil formatted text from the given 'source'.
///           This is the main user-visible entry point for parsing.
define open generic parse-coil
    (source :: <object>) => (coil :: <struct>);

define method parse-coil
    (source :: <locator>) => (coil :: <struct>)
  with-open-file (stream = source, direction: input:)
    %parse-coil(make(<coil-parser>,
                     source: source,
                     text: read-to-end(stream)))
  end
end;

define method parse-coil
    (source :: <stream>) => (coil :: <struct>)
  %parse-coil(make(<coil-parser>, text: read-to-end(source)))
end;

define method parse-coil
    (source :: <string>) => (coil :: <struct>)
  %parse-coil(make(<coil-parser>, text: source))
end;

define method %parse-coil
    (p :: <coil-parser>) => (struct :: <struct>)
  let root = make(<struct>, name: "@root");
  resolve-references!(p, parse-struct-attributes(p, root), #());
  root
end;

define method parse-struct
    (p :: <coil-parser>, key :: <string>) => (struct :: <struct>)
  let struct = make(<struct>, name: key);
  eat-whitespace-and-comments(p);
  select (p.lookahead)
    '{' =>
      p.consume;
      parse-struct-attributes(p, struct);
      expect(p, "}");
    otherwise =>
      parse-error(p, "Invalid struct.  Expected '{'.");
  end;
  struct
end method parse-struct;

/// Synopsis: Parse the attributes of a struct and add them to the 'struct'
///           argument passed in.  @extends, @file, and deletions are added
///           to the struct under special names (which aren't valid as keys)
///           so that they may be resolved during a second pass.
define method parse-struct-attributes
    (p :: <coil-parser>, struct :: <struct>) => (struct :: <struct>)
  iterate loop (n = 1)
    eat-whitespace-and-comments(p);
    select (p.lookahead)
      '}', #f =>
        #f;  // done
      '~' =>
        p.consume;
        let link :: <link> = parse-link(p);
        struct[make-compound-key("@delete@", link.link-name)] := link;
        loop(n);
      '@' =>
        p.consume;
        select (p.lookahead)
          'e' =>
            expect(p, "extends", ":");
            let key = make-compound-key("@extends@", integer-to-string(n));
            struct[key] := parse-link(p);
            loop(n + 1);
          'f' =>
            expect(p, "file", ":");
            let filename = parse-any(p);
            let key = make-compound-key("@file@", integer-to-string(n));
            select (filename by instance?)
              <string> =>
                // @file: "foo.coil"
                // TODO(cgay): This should really merge against the current
                // pathname, not the original pathname passed to the parser.
                // i.e., nested @file links won't use the correct relative path.
                let file = as(<file-locator>, filename);
                if (p.source-locator)
                  file := merge-locators(file, p.source-locator);
                end;
                struct[key] := parse-coil(file);
                loop(n + 1);
              <sequence> =>
                // @file: [ "foo.coil" @root.a.b ]
                let (filename, path) = apply(values, filename);
                let file-struct = parse-coil(as(<file-locator>, filename));
                let target :: <struct> = file-struct[path];
                target.struct-parent := struct;
                struct[key] := target;
                loop(n + 1);
              otherwise =><commit_msg>Add TODO comment.<commit_after>Module: %coil
Synopsis: Ad-hoc recursive descent parser for coil configs
Author: <NAME>
Copyright: Copyright (c) 2013 <NAME>.  All rights reserved.
License:   See LICENSE.txt in this distribution for details.

/*

This parser makes two passes.  During the first pass objects that
don't involve any links outside the struct are parsed, and most
struct keys are filled in.  The second pass resolves @extends,
@file, deletions, compound struct keys (i.e., a.b.c: foo) and
struct value links (i.e., foo: a.b.c).  This is necessary because
@extends and @file may change what a.b.c refers to.

During the first pass, keys begining with '@' are used as placeholders
for items that need to be resolved during the second pass.  This works
because '@' isn't a valid character in coil struct keys.

A basic rule is that structs must be parsed in textual order.  Structs
that appear in the source file textually before other structs should
be fully parsed before those that appear later.  e.g., if a struct has
both "x: y" and "~x" then the "winner" is whichever one appears last.

TODO:
+ What are the intended semantics when a struct has both x and ~x?

+ Keep track of the source location of items that are resolved during
  the second pass, for better error messages.

*/

define constant $whitespace :: <string>
  = " \t\n\r";

define constant $token-terminators :: <string>
  = concatenate($whitespace, "}]\"");

define constant $key-regex :: <regex>
  = compile-regex("-*[a-zA-Z_][\\w-]*");

define constant $extended-key-regex :: <regex>
  = compile-regex(format-to-string("%s(\\.%s)*",
                                   $key-regex.regex-pattern,
                                   $key-regex.regex-pattern));

define constant $path-regex :: <regex>
  = compile-regex(format-to-string("(@|\\.+)?%s(\\.%s)*",
                                   $key-regex.regex-pattern,
                                   $key-regex.regex-pattern));


/// Synopsis: '$none' is what "None" parses to.
///
define class <none> (<object>) end;
define constant $none :: <none> = make(<none>);

define class <coil-parser> (<object>)
  constant slot source-locator :: false-or(<file-locator>) = #f,
    init-keyword: source:;

  // Text is the entire original coil source text.
  constant slot input-text :: <string> = "", required-init-keyword: text:;

  // Index points to the next character to be read by "consume".
  slot current-index :: <integer> = 0;

  // Line and column are for error reporting.  They are maintained by "consume".
  slot line-number :: <integer> = 1, init-keyword: line:;
  slot column-number :: <integer> = 1, init-keyword: column:;
end class <coil-parser>;


/// Synopsis: Any error signalled during parsing (except for file
///           system errors) will be an instance of this.
define class <coil-parse-error> (<coil-error>)
end;


/// Synopsis: Signal <coil-parse-error> with the given 'format-string' and
///           'args' as the message.  If the current source location is known
///           it is prefixed to the message.
define method parse-error
    (p :: <coil-parser>, format-string, #rest args)
  let context = format-to-string("@%d:%d ", p.line-number, p.column-number);
  let message = concatenate(context,
                            apply(format-to-string, format-string, args),
                            "\n", p.current-line,
                            "\n", p.indicator-line);
  error(make(<coil-parse-error>, format-string: message));
end;

/// Synopsis: Return the line pointed to by 'current-index'.
///
define method current-line
    (p :: <coil-parser>) => (line :: <string>)
  let max = p.input-text.size;
  let curr = p.current-index;
  let epos = min(position(p.input-text, '\n', start: curr) | max,
                 position(p.input-text, '\r', start: curr) | max);
  slice(p.input-text,
        p.current-index - p.column-number + 1,
        epos)
end;

/// Synopsis: Return a line that indicates which character 'current-index'
///           points to.  ".........^"
define method indicator-line
    (p :: <coil-parser>) => (line :: <string>)
  let line = make(<string>, size: p.column-number, fill: '.');
  line[p.column-number - 1] := '^';
  line
end;

/// Synopsis: Parse coil formatted text from the given 'source'.
///           This is the main user-visible entry point for parsing.
define open generic parse-coil
    (source :: <object>) => (coil :: <struct>);

define method parse-coil
    (source :: <locator>) => (coil :: <struct>)
  with-open-file (stream = source, direction: input:)
    %parse-coil(make(<coil-parser>,
                     source: source,
                     text: read-to-end(stream)))
  end
end;

define method parse-coil
    (source :: <stream>) => (coil :: <struct>)
  %parse-coil(make(<coil-parser>, text: read-to-end(source)))
end;

define method parse-coil
    (source :: <string>) => (coil :: <struct>)
  %parse-coil(make(<coil-parser>, text: source))
end;

define method %parse-coil
    (p :: <coil-parser>) => (struct :: <struct>)
  let root = make(<struct>, name: "@root");
  resolve-references!(p, parse-struct-attributes(p, root), #());
  root
end;

define method parse-struct
    (p :: <coil-parser>, key :: <string>) => (struct :: <struct>)
  let struct = make(<struct>, name: key);
  eat-whitespace-and-comments(p);
  select (p.lookahead)
    '{' =>
      p.consume;
      parse-struct-attributes(p, struct);
      expect(p, "}");
    otherwise =>
      parse-error(p, "Invalid struct.  Expected '{'.");
  end;
  struct
end method parse-struct;

/// Synopsis: Parse the attributes of a struct and add them to the 'struct'
///           argument passed in.  @extends, @file, and deletions are added
///           to the struct under special names (which aren't valid as keys)
///           so that they may be resolved during a second pass.
define method parse-struct-attributes
    (p :: <coil-parser>, struct :: <struct>) => (struct :: <struct>)
  iterate loop (n = 1)
    eat-whitespace-and-comments(p);
    select (p.lookahead)
      '}', #f =>
        #f;  // done
      '~' =>
        p.consume;
        let link :: <link> = parse-link(p);
        struct[make-compound-key("@delete@", link.link-name)] := link;
        loop(n);
      '@' =>
        p.consume;
        select (p.lookahead)
          'e' =>
            expect(p, "extends", ":");
            let key = make-compound-key("@extends@", integer-to-string(n));
            struct[key] := parse-link(p);
            loop(n + 1);
          'f' =>
            expect(p, "file", ":");
            let filename = parse-any(p);
            let key = make-compound-key("@file@", integer-to-string(n));
            select (filename by instance?)
              <string> =>
                // @file: "foo.coil"
                // TODO(cgay): This should really merge against the current
                // pathname, not the original pathname passed to the parser.
                // i.e., nested @file links won't use the correct relative path.
                // TODO(cgay): catch circular @file references.
                let file = as(<file-locator>, filename);
                if (p.source-locator)
                  file := merge-locators(file, p.source-locator);
                end;
                struct[key] := parse-coil(file);
                loop(n + 1);
              <sequence> =>
                // @file: [ "foo.coil" @root.a.b ]
                let (filename, path) = apply(values, filename);
                let file-struct = parse-coil(as(<file-locator>, filename));
                let target :: <struct> = file-struct[path];
                target.struct-parent := struct;
                struct[key] := target;
                loop(n + 1);
              otherwise =>
{'fraction_non_alphanumeric': 0.1492170311893361, 'fraction_numerical': 0.001682412320434839, 'mean_word_length': 2.3459623295085517, 'pattern_counts': {'":': 4, '<': 115, '<?xml version=': 0, '>': 153, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3901022', 'n_tokens_mistral': 4766, 'n_tokens_neox': 4590, 'n_words': 1487}