agent | 27 Apr 18:00

[chatter] r11780 - trunk/libraries/utilities/peg-parser

Author: agent
Date: Sun Apr 27 18:02:27 2008
New Revision: 11780

Modified:
   trunk/libraries/utilities/peg-parser/parser-definers.dylan
   trunk/libraries/utilities/peg-parser/parser-rules.dylan
   trunk/libraries/utilities/peg-parser/parser-support.dylan
Log:
Job: minor
* Added add'l optional type specs to macros.
* Fixed semicolon error in afterwards clause.
* Improved collect-subelements function.

Modified: trunk/libraries/utilities/peg-parser/parser-definers.dylan
==============================================================================
--- trunk/libraries/utilities/peg-parser/parser-definers.dylan	(original)
+++ trunk/libraries/utilities/peg-parser/parser-definers.dylan	Sun Apr 27 18:02:27 2008
@@ -5,7 +5,7 @@
 // rule parsers parse a stream in a given context and return a value or sequence
 // of values called the "product."

-/// SYNOPSIS: Defines an arbitrary 'rule parser'.
+/// SYNOPSIS: Defines an arbitrary rule parser.
 /// DISCUSSION: This macro defines a rule parser that includes support for
 /// debugging and other features described for rule parsers. The main part of
 /// the parser is Dylan code supplied by you.
@@ -53,7 +53,7 @@
 end macro;

 
-/// SYNOPSIS: Defines a 'rule parser' and perhaps a token class for a given
+/// SYNOPSIS: Defines a rule parser and perhaps a token class for a given
 /// token.
 ///
 /// The macro takes three forms: class, yield, and basic.
@@ -70,27 +70,28 @@
 /// end parser;
 /// [end code]
 ///
-/// defines a rule parser named `parse-t` and a token class named `<t-token>`
-/// which inherits from `<c>` (optional) and `<token>`. `<t-token>` will have
-/// a slot named `content` (inherited from <c>) and a slot named `more-content`.
-/// When <t-token> is initialized, `tokens` gets set to the product of the rule
-/// `many(t2)`, `content` gets set to the expression `tokens[1]`, and
-/// `more-content` gets set to the expression `tokens[2]` (which must be a
-/// <string>).
+/// defines a rule parser named parse-t and a token class named <t-token>
+/// which inherits from <c> and <token>. The superclass is optional, but the
+/// parentheses aren't. <t-token> will have a slot named content (inherited
+/// from <c>) and a slot named more-content. When <t-token> is initialized,
+/// tokens gets set to the product of the rule `many(t2)`, content gets set to
+/// the expression `tokens[1]`, and more-content gets set to the expression
+/// `tokens[2]` (which must be a <string>).
 /// 
 /// === Yield form ===
 ///
 /// Yield form returns a value.
 ///
 /// [code]
-/// define parser t
+/// define parser t :: <token>
 ///   rule many(t2) => tokens;
 ///   yield tokens[1];
 /// end parser;
 /// [end code]
 ///
-/// defines a rule parser that returns `tokens[1]` directly, without defining
-/// a `<t-token>` class.
+/// defines a rule parser that returns `tokens[1]` (which must be a <token>)
+/// directly, without defining a <t-token> class. The type specialization is
+/// optional.
 ///
 /// === Basic form ===
 ///
@@ -102,12 +103,13 @@
 /// end parser;
 /// [end code]
 ///
-/// defines a rule parser that return `#"t"`.
+/// defines a rule parser that returns #"t".
 ///
 /// === Affecting context ===
 ///
 /// All three forms allow two additional clauses, "afterwards" and "cleanup,"
-/// that perform actions after the rule parser matches or fails to match.
+/// that perform actions after the rule parser matches or fails to match. These
+/// actions are inherited by token subclasses.
 ///
 /// [code]
 /// define parser t ()
@@ -140,7 +142,7 @@
    // This form creates a parser that return an initialized <token> class.
    {
       define parser ?token-name:name (?supers)
-         rule ?rule => ?product-name:name;
+         rule ?rule => ?product-name:name :: ?product-type:expression;
          ?class-slots-and-clauses
       end
    } => {
@@ -149,7 +151,9 @@

       // Initialize the class's slots based on results of rule.
       define method initialize (?token-name :: "<" ## ?token-name ## "-token>",
-            #next next-method, #key ?product-name = unsupplied())
+            #next next-method,
+            #key ?product-name :: type-union(?product-type, singleton(unsupplied()))
+                 = unsupplied())
          next-method();
          if (supplied?(?product-name))
             slot-initializers(?token-name; ?class-slots-and-clauses)
@@ -167,7 +171,7 @@
          indent-trace();
          format-trace(?"token-name" ## "...");
          let pos = stream.stream-position;
-         let production =
+         let production :: ?product-type =
                block()
                   // User-defined match action on rule product
                   "match-" ## ?token-name
@@ -204,8 +208,8 @@
    //
    // This form creates a parser that returns the result of an expression.
    {
-      define parser ?token-name:name
-         rule ?rule => ?product-name:name;
+      define parser ?token-name:name :: ?token-type:expression
+         rule ?rule => ?product-name:name :: ?product-type:expression;
          yield ?:expression;
          ?body-clauses
       end
@@ -216,11 +220,11 @@
       // Define the parser function including tracing and rollback. Result is
       // yield expression.
       define function "parse-" ## ?token-name
-            (stream :: <positionable-stream>, context) => (token)
+            (stream :: <positionable-stream>, context) => (token :: ?token-type)
          indent-trace();
          format-trace(?"token-name" ## "...");
          let pos = stream.stream-position;
-         let ?product-name =
+         let ?product-name :: ?product-type =
                block()
                   // User-defined match action on rule product
                   "match-" ## ?token-name
@@ -337,9 +341,9 @@
 // Optional. Note that the body is turned into an expression, which is why the
 // 'user-functions' auxiliary macro takes an expression instead of a body.
 body-clauses:
-   { afterwards (?context:name, ?product:name) ?:body; ... }
+   { afterwards (?context:variable, ?product:variable) ?:body ... }
       => { afterwards ?context, ?product, ?body; ... }
-   { cleanup (?context:name) ?:body }
+   { cleanup (?context:variable) ?:body }
       => { cleanup ?context, ?body }
    { } => { }
 end macro;
@@ -402,36 +406,46 @@

    {
       user-functions(?token:name;
-            afterwards ?after-ctxt:name, ?after-prod:name, ?after-expr:expression;
-            cleanup ?clean-ctxt:name, ?clean-expr:expression)
+            afterwards ?after-ctxt:name :: ?after-ctxt-type:expression,
+                       ?after-prod:name :: ?after-ctxt-type:expression,
+                       ?after-expr:expression;
+            cleanup ?clean-ctxt:name :: ?clean-ctxt-type:expression,
+                    ?clean-expr:expression)
    } => {
-      define inline function "match-" ## ?token (?after-ctxt, ?after-prod)
-      => (p)
+      define inline function "match-" ## ?token
+         (?after-ctxt :: ?after-ctxt-type, ?after-prod :: ?after-prod-type)
+      => (p :: ?after-prod-type)
          ?after-expr; ?after-prod;
       end function;
-      define inline function "cleanup-" ## ?token (?clean-ctxt) => ()
+      define inline function "cleanup-" ## ?token
+            (?clean-ctxt :: ?clean-ctxt-type) => ()
          ?clean-expr
       end function;
    }

    {
       user-functions(?token:name;
-            cleanup ?clean-ctxt:name, ?clean-expr:expression)
+            cleanup ?clean-ctxt:name :: ?clean-ctxt-type:expression,
+                    ?clean-expr:expression)
    } => {
       define inline function "match-" ## ?token (c, p) => (p)
          p
       end function;
-      define inline function "cleanup-" ## ?token (?clean-ctxt) => ()
+      define inline function "cleanup-" ## ?token
+            (?clean-ctxt :: ?clean-ctxt-type) => ()
          ?clean-expr
       end function;
    }

    {
       user-functions(?token:name;
-            afterwards ?after-ctxt:name, ?after-prod:name, ?after-expr:expression)
+            afterwards ?after-ctxt:name :: ?after-ctxt-type:expression,
+                       ?after-prod:name :: ?after-prod-type:expression,
+                       ?after-expr:expression)
    } => {
-      define inline function "match-" ## ?token (?after-ctxt, ?after-prod)
-      => (p)
+      define inline function "match-" ## ?token
+         (?after-ctxt :: ?after-ctxt-type, ?after-prod :: ?after-prod-type)
+      => (p :: ?after-prod-type)
          ?after-expr; ?after-prod
       end function;
       define inline function "cleanup-" ## ?token (c) => ()

Modified: trunk/libraries/utilities/peg-parser/parser-rules.dylan
==============================================================================
--- trunk/libraries/utilities/peg-parser/parser-rules.dylan	(original)
+++ trunk/libraries/utilities/peg-parser/parser-rules.dylan	Sun Apr 27 18:02:27 2008
@@ -19,7 +19,7 @@
 ///
 /// Rollback and naming are done automatically when using 'parser-method-definer'
 /// or 'parser-definer' macros or the 'seq' etc. functions, but with the
-/// 'parser-method-definer' macro, you have to signal <parse-failure> on failure.
+/// 'parser-method-definer' macro, you have to signal <parse-failure> yourself.
 ///
 /// ARGUMENTS:
 ///   stream   - An instance of <positionable-stream>.
@@ -27,16 +27,17 @@
 /// VALUES:
 ///   product  - An instance of <sequence>, #f, or some other value (usually
 ///              an instance of <token>), depending on the parser's rule(s).
-///              If the parser fails to match, it signals <parse-failure>.
+/// CONDITIONS:
+///   If the parser fails to match, it signals <parse-failure>.

 
-/// SYNOPSIS: Builds a 'rule parser' matching a sequence of elements.
+/// SYNOPSIS: Builds a rule parser matching a sequence of elements.
 ///           Equivalent to PEG "p1 p2" operation.
 /// ARGUMENTS:
-///   "#rest sub-rules" - A series of 'rule parser's, all of which must succeed
+///   "#rest sub-rules" - A series of rule parsers, all of which must succeed
 ///                       for the returned parser to succeed.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning a <sequence>. The sequence will
+///   rule-parser - A rule parser returning a <sequence>. The sequence will
 ///                 contain the sub-rules' products.
 define function seq (#rest sub-rules) => (rule-parser :: <function>)
    local method seq-parser (stream :: <positionable-stream>, context)
@@ -60,13 +61,13 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' matching one of several elements.
+/// SYNOPSIS: Builds a rule parser matching one of several elements.
 ///           Equivalent to PEG "p1 / p2" operation.
 /// ARGUMENTS:
-///   "#rest sub-rules" - A series of 'rule parser's, the first of which to
+///   "#rest sub-rules" - A series of rule parsers, the first of which to
 ///                       succeed supplies the parser's product.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning one of the sub-rules' products.
+///   rule-parser - A rule parser returning one of the sub-rules' products.
 define function choice (#rest sub-rules) => (rule-parser :: <function>)
    local method choice-parser (stream :: <positionable-stream>, context)
    => (product)
@@ -93,12 +94,12 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' matching one or more elements.
+/// SYNOPSIS: Builds a rule parser matching one or more elements.
 ///           Equivalent to PEG "p1+" operation.
 /// ARGUMENTS:
-///   sub-rule - A 'rule parser'.
+///   sub-rule - A rule parser.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning a <sequence> containing the
+///   rule-parser - A rule parser returning a <sequence> containing the
 ///                 sub-rule's products. 
 define function many (sub-rule :: <function>) => (rule-parser :: <function>)
    local method many-parser (stream :: <positionable-stream>, context)
@@ -124,12 +125,12 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' matching zero or one element.
+/// SYNOPSIS: Builds a rule parser matching zero or one element.
 ///           Equivalent to PEG "p1?" operation.
 /// ARGUMENTS:
-///   sub-rule - A 'rule parser'.
+///   sub-rule - A rule parser.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning the sub-rule's product, or #f if
+///   rule-parser - A rule parser returning the sub-rule's product, or #f if
 ///                 the element is not present.
 define function opt (sub-rule :: <function>) => (rule-parser :: <function>)
    local method opt-parser (stream :: <positionable-stream>, context)
@@ -146,12 +147,12 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' matching zero or more elements.
+/// SYNOPSIS: Builds a rule parser matching zero or more elements.
 ///           Equivalent to PEG "p1*" operation.
 /// ARGUMENTS:
-///   sub-rule - A 'rule parser'.
+///   sub-rule - A rule parser.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning a <sequence> containing the
+///   rule-parser - A rule parser returning a <sequence> containing the
 ///                 sub-rule's products, or #f if the elements are not present. 
 define function opt-many (sub-rule :: <function>) => (rule-parser :: <function>)
    local method opt-many-parser (stream :: <positionable-stream>, context)
@@ -172,13 +173,13 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' matching all elements or none of them.
+/// SYNOPSIS: Builds a rule parser matching all elements or none of them.
 ///           Equivalent to PEG "(p1 p2)?" operation.
 /// ARGUMENTS:
-///   "#rest sub-rules" - A series of 'rule parser's, all of which must match
+///   "#rest sub-rules" - A series of rule parsers, all of which must match
 ///                       for this parser to match.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning #f or a <sequence> containing
+///   rule-parser - A rule parser returning #f or a <sequence> containing
 ///                 all sub-rules' products.
 define function opt-seq (#rest sub-rules) => (rule-parser :: <function>)
    let parser = opt(apply(seq, sub-rules));
@@ -189,12 +190,12 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' matching one of the specified elements or
+/// SYNOPSIS: Builds a rule parser matching one of the specified elements or
 /// none of them. Equivalent to PEG "(p1 / p2)?" operation.
 /// ARGUMENTS:
-///   "#rest sub-rules" - A series of 'rule parser's.
+///   "#rest sub-rules" - A series of rule parsers.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning #f or the product of the
+///   rule-parser - A rule parser returning #f or the product of the
 ///                 matching rule.
 define function opt-choice (#rest sub-rules) => (rule-parser :: <function>)
    let parser = opt(apply(choice, sub-rules));
@@ -205,12 +206,12 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' that looks ahead to match the sub-rule
+/// SYNOPSIS: Builds a rule parser that looks ahead to match the sub-rule
 /// without consuming any elements. Equivalent to PEG "&p1" operation.
 /// ARGUMENTS:
-///   sub-rule - A 'rule parser'.
+///   sub-rule - A rule parser.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning #f.
+///   rule-parser - A rule parser returning #f.
 define function req-next (sub-rule :: <function>) => (rule-parser :: <function>)
    local method req-next-parser (stream :: <positionable-stream>, context)
    => (product :: <boolean>)
@@ -230,13 +231,13 @@
 end function;

 
-/// SYNOPSIS: Builds a 'rule parser' that looks ahead to ensure the sub-rule
+/// SYNOPSIS: Builds a rule parser that looks ahead to ensure the sub-rule
 /// does not match, but does not consume any elements in doing so.
 /// Equivalent to PEG "!p1" operation.
 /// ARGUMENTS:
-///   sub-rule - A 'rule parser'.
+///   sub-rule - A rule parser.
 /// VALUES:
-///   rule-parser - A 'rule parser' returning #f.
+///   rule-parser - A rule parser returning #f.
 define function not-next (sub-rule :: <function>) => (rule-parser :: <function>)
    local method not-next-parser (stream :: <positionable-stream>, context)
    => (product :: <boolean>)

Modified: trunk/libraries/utilities/peg-parser/parser-support.dylan
==============================================================================
--- trunk/libraries/utilities/peg-parser/parser-support.dylan	(original)
+++ trunk/libraries/utilities/peg-parser/parser-support.dylan	Sun Apr 27 18:02:27 2008
@@ -37,6 +37,9 @@

 
 /// SYNOPSIS: Builds and caches a parser name, for debugging and exceptions.
+/// DISCUSSION: This whole system I've devised for parser names does not work
+/// when it comes to the parsers created by 'seq', etc. I have no idea why,
+/// but they all show up as "?".
 define function rule-name (rule-func :: <function>) => (name :: <string>)
    if (~member?(rule-func, *rule-names*))
       let parts = element(*rule-name-parts*, rule-func, default: #("?"));
@@ -88,20 +91,24 @@
 /// : #[1, "blue"]
 ///
 /// ARGUMENTS:
-///   sequences   - A collection of <sequence>.
+///   sequences   - A collection of <sequence>, or #f.
 ///   index       - An <integer>. The element of each of 'sequences' that should
-///                 be pulled out into a new resulting sequence.
+///                 be pulled out into a new sequence.
 ///   default:    - An <object>. If the sequence doesn't have an element at
 ///                 'index', this value is used instead. Defaults to #f.
 /// VALUES:
-///   new-sequence - The resulting sequence.
+///   new-sequence - The resulting sequence. It is empty if 'sequences' is #f.
 define function collect-subelements
-   (sequences :: <collection>, index :: <integer>, #key default = #f)
+   (sequences :: false-or(<collection>), index :: <integer>, #key default = #f)
 => (new-sequence :: <sequence>)
-   map-as(<deque>,
-          method (sequence :: <sequence>) => (item :: <object>)
-             element(sequence, index, default: default)
-          end,
-          sequences)
+   if (sequences)
+      map-as(<deque>,
+             method (sequence :: <sequence>) => (item :: <object>)
+                element(sequence, index, default: default)
+             end,
+             sequences)
+   else
+      #()
+   end if
 end function;

_______________________________________________
chatter mailing list
chatter <at> lists.opendylan.org
https://www.opendylan.org/mailman/listinfo/chatter


Gmane