[gnunet-scheme] 100/324: config: parser: Define return types for expansion parser.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 19d609030401694ae269daa9d7a47b7ee0b9ecd0
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Mar 25 21:30:18 2021 +0100

    config: parser: Define return types for expansion parser.
    
    * gnu/gnuent/config/parser.scm: Define the data types and
      conditions.
---
 gnu/gnunet/config/parser.scm | 134 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 130 insertions(+), 4 deletions(-)

diff --git a/gnu/gnunet/config/parser.scm b/gnu/gnunet/config/parser.scm
index 51fe4d3..5ee088e 100644
--- a/gnu/gnunet/config/parser.scm
+++ b/gnu/gnunet/config/parser.scm
@@ -23,7 +23,7 @@
 
 ;; TODO: unquoting, expanding variable references
 (define-library (gnu gnunet config parser)
-  (export parse-line
+  (export parse-line ;; line parser
          <position:%> make-%-position %-position?
          position:%
          <position:#> make-#-position #{#-position?}#
@@ -35,7 +35,29 @@
          position:section-name-start position:section-name-end
          <position:@inline@> make-@inline@-position @inline@-position?
          position:@inline@-start position:@inline@-end
-         position:@inline@-filename-start position:@inline@-filename-end)
+         position:@inline@-filename-start position:@inline@-filename-end
+
+         ;; expansion parser (data types)
+         <expo:literal> make-literal-position literal-position?
+         <expo:$> make-$-position $-position?
+         #{<expo:${}>}# #{make-${}-position}# #{${}-position?}#
+         #{<expo:${:-}>}# #{make-${:-}-position}# #{${:-}-position?}#
+
+         expo:literal-start expo:literal-end
+         expo:$-name-start expo:$-name-end
+         #{expo:${}-name-start}# #{expo:${}-name-end}#
+         #{expo:${:-}-name-start}# #{expo:${:-}-name-end}#
+         #{expo:${:-}-value-start}# #{expo:${:-}-value-end}#
+         #{expo:${:-}-value-parts}#
+
+         ;; expansion parser (conditions)
+         &expansion-violation &empty-variable-violation &missing-close
+         make-empty-variable-violation make-missing-close-violation
+         expansion-violation? empty-variable-violation? 
missing-close-violation?
+         expansion-violation-position empty-variable-kind missing-close-kind
+
+         ;; TODO: the parser!
+         )
   (import (only (guile)
                eval-when quote
                char-set:whitespace
@@ -44,12 +66,16 @@
          (only (rnrs base)
                begin define lambda define-syntax syntax-rules ...
                assert or + - if char=? not and exact? integer?
-               < <=
+               < <= =
                string-length string-ref)
          (only (rnrs control)
                unless)
          (only (rnrs records syntactic)
                define-record-type)
+         (only (rnrs conditions)
+               define-condition-type
+               &lexical)
+         (only (rnrs lists) memq)
          (only (gnu gnunet utils hat-let)
                let^))
   (begin
@@ -221,4 +247,104 @@ of other types may be returned."
                                         (+ 1 end-inclusive)))
             (! value-start (or value-start (+ 1 end-inclusive))))
            (make-=-position start-inclusive variable-end
-                            =-position value-start (+ 1 end-inclusive))))))
+                            =-position value-start (+ 1 end-inclusive))))
+
+    
+    ;; * The (recursive) position-preserving variable substitutions parser.
+    ;; We support: "literal-stuff", "${var}" "$var", "${VAR:-stuff}".
+    ;; First define some data types.
+
+    (define-positions-type (<expo:literal> make-literal-position 
literal-position?)
+      ((literal-start expo:literal-start)
+       (literal-end expo:literal-end))
+      ((< literal-start literal-end))
+      "@var{literal-start} (inclusive) and @var{literal-end} (exclusive) are
+the start and end positions of a region of texts without expansions.")
+
+    (define-positions-type (<expo:$> make-$-position $-position?)
+      (($-name-start expo:$-name-start)
+       ($-name-end expo:$-name-end))
+      ((< $-name-start $-name-end))
+      "@var{$-name-start} (inclusive) and @var{$-name-end} (exclusive) are the
+start and end positions of a variable name in an expansion X/$VAR/etcetera.")
+
+    (define-positions-type (#{<expo:${}>}# #{make-${}-position}#
+                           #{${}-position?}#)
+      ((#{${}-name-start}# #{expo:${}-name-start}#)
+       (#{${}-name-end}# #{expo:${}-name-end}#))
+      ((< #{${}-name-start}# #{${}-name-end}#))
+      "@var{$@{@}-name-start} (inclusive) and @var{$@{@}-name-end}
+(exclusive) are the start and end positions of a variable name in an expansion
+${VAR}.")
+
+    (define-record-type (#{<expo:${:-}>}# #{make-${:-}-position}#
+                        #{${:-}-position?}#)
+      (fields (immutable #{${:-}-name-start}# #{expo:${:-}-name-start}#)
+             (immutable #{${:-}-name-end}# #{expo:${:-}-name-end}#)
+             (immutable #{${:-}-value-start}# #{expo:${:-}-value-start}#)
+             (immutable #{${:-}-value-end}# #{expo:${:-}-value-end}#)
+             (immutable #{${:-}-value-parts}# #{expo:${:-}-value-parts}#))
+      (sealed #t)
+      (opaque #t)
+      (protocol
+       (lambda (%make)
+        (lambda (#{${:-}-name-start}# #{${:-}-name-end}#
+                 #{${:-}-value-start}# #{${:-}-value-end}#
+                 #{${:-}-value-parts}#)
+          "@var{$@{:-@}-name-start} (inclusive) and @var{$@{:-@}-name-end}
+(exclusive) are the start and end positions of a variable name in an expansion
+@samp{$@{VAR:-DEFAULT-VALUE@}}.  @var{$@{:-@}-value-start} (inclusive) and
+@var{$@{:-@}-value-end} (exclusive) are the start and end positions of
+DEFAULT-VALUE.  @var{${:-}-value-parts} is an ordered list of contiguous
+expansion position objects, representing the structure of @samp{DEFAULT-VALUE}
+(unverified)."
+          (assert (and (exact-integers?
+                        #{${:-}-name-start}# #{${:-}-name-end}#
+                        #{${:-}-value-start}# #{${:-}-value-end}#)
+                       (<= 0 #{${:-}-name-start}#)
+                       (< #{${:-}-name-start}# #{${:-}-name-end}#)
+                       (= (- #{${:-}-value-start}# #{${:-}-name-end}#) 2)
+                       (<= #{${:-}-value-start}# #{${:-}-value-end}#)))
+          (%make (#{${:-}-name-start}# #{${:-}-name-end}#
+                  #{${:-}-value-start}# #{${:-}-value-end}#
+                  #{${:-}-value-parts}#))))))
+
+    ;; Now define the possible syntax errors.
+    (define-condition-type &expansion-violation &lexical
+      %make-expansion-violation expansion-violation?
+      (position expansion-violation-position))
+
+    (define (make-expansion-violation position)
+      (assert (and (exact-integers? position) (<= 0 position)))
+      (%make-expansion-violation position))
+
+    (define-condition-type &empty-variable-violation &expansion-violation
+      %make-empty-variable-violation empty-variable-violation?
+      ;; $, ${} or ${:-}
+      (kind empty-variable-kind))
+
+    (define (make-empty-variable-violation position kind)
+      "Make a condition indicating at position @var{position} a variable
+name was expected, but only an empty string was found.  The symbol @var{kind}
+indicates the type of variable expansion found: @code{$@{:-@}} for variable
+expansions with a default, @code{$@{@}} for braced variable expansions without
+default and @code{$} for unbraced variable expansions."
+      (assert (and (exact-integers? position)
+                  (<= 0 position)
+                  (memq kind '($ #{${}}# #{${:-}}#))))
+      (%make-empty-variable-violation position position kind))
+
+    (define-condition-type &missing-close &expansion-violation
+      %make-missing-close-violation? missing-close-violation?
+      ;; ${} or ${:-}
+      (kind missing-close-kind))
+
+    (define (make-missing-close-violation position kind)
+      "Make a condition indicating at position @var{position} a closing
+brace (@code{#\\@}) was expected, but not found.  The symbol @var{kind}
+indicates the type of variable expansion found, as in
+@code{empty-variable-violation}, though it cannot be @code{$@}."
+      (assert (and (exact-integers? position)
+                  (<= 0 position)
+                  (memq kind '(#{${}}# #{${:-}}#))))
+      (%make-empty-variable-violation position position kind))))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.