Conceived parameterized parsers: implements io-here.

sh.peg.scm

@@ -37,8 +37,24 @@
     (apply system* cmd)
     ))
 
-;; insert / error at convenient location to short circuit backtracking
+
 (define (parse input)
+
+  (define label "")
+  (define (label-name str len pos)
+    (let ((at (string-skip str char-alphabetic? pos len)))
+      (set! label (substring str pos at))
+      (if (< at len) (list at '())
+          #f)))
+
+  (define (label-match str len pos)
+    (if (string-prefix? label (substring str pos)) (list (+ pos (string-length label)) '())
+        #f))
+
+  (define-peg-pattern here-label none label-name)
+  (define-peg-pattern here-delim none label-match)
+  (define-peg-pattern here-document all (and (+ (and (not-followed-by here-delim) peg-any)) here-delim))
+
 (define-peg-string-patterns
 "script           <-- (sp / linebreak)* (term (separator term)* separator?)?
  term             <-- pipeline (sp* (and / or) (sp / linebreak)* pipeline)*
@@ -63,14 +79,13 @@
  function-body    <-- compound-command io-redirect*
  brace-group      <-- '{' sp* compound-list sp* '}'
  simple-command   <-- (io-redirect sp+)* !reserved word (sp+ (io-redirect / (!reserved word)))*
- xsimple-command   <-- !reserved ((cmd-prefix (sp+ cmd-suffix)?) / (word (sp+ cmd-suffix)?))
  reserved         <   ('if' / 'then' / 'else' / 'elif' / 'fi' / 'for' / 'done' / 'do' / 'until' / 'while') (sp / linebreak)
- cmd-prefix       <-- (io-redirect (sp* io-redirect)*) / (word (sp+ word)*)
- cmd-suffix       <-- (io-redirect (sp* io-redirect)*) / (word (sp+ word)*)
  io-redirect      <-- [0-9]* sp* (io-here / io-file)
  io-file          <-- ('<&' /  '>&' / '>>' / '>' / '<>'/ '<' / '>|') sp* ([0-9]+ / filename)
+ io-here          <-  ('<<' / '<<-') io-suffix here-document
+ io-op            <   '<<-' / '<<' / '<&' /  '>&' / '>>' / '>' / '<>'/ '<' / '>|'
+ io-suffix        <-  sp* here-label sp* linebreak
  filename         <-- word
- io-here          <-- ('<<' / '<<-') sp* word
  name             <-- identifier
  identifier       <-- [_a-zA-Z][_a-zA-Z0-9]*
  word             <-- test / substitution / assignment / literal
@@ -80,15 +95,16 @@
  substitution     <-- ('$' '(' script ')') / ('`' word (sp+ word)* '`')
  assignment       <-- name assign word?
  assign           <   '='
- literal          <-  (subst / delim / (![0-9] (!sp !linebreak ![;&|$()=] .)+) / ([0-9]+ &separator)) literal*
+ literal          <-  (subst / delim / (![0-9] (!io-op !sp !linebreak !break !pipe !assign .)+) / ([0-9]+ &separator)) literal*
  subst            <-  '$' ('$' / '*' / '@' / [0-9] / identifier / ([{] (![}] .)+ [}]))
  delim            <-  (['] (!['] .)* [']) / ([\"] (![\"] .)* [\"]) / ([`] (![`] .)* [`])
  separator        <-- (sp* break (sp / linebreak)*) / (sp / linebreak)+
  break            <-- '&' / ';'
- sequential-sep   <--  (semi (sp / linebreak)*) / (sp / linebreak)+
- semi             < ';'
- linebreak        <   [\r\n]
+ sequential-sep   <-- (semi (sp / linebreak)*) / (sp / linebreak)+
+ semi             <   ';'
+ linebreak        <   '\n'
  sp               <   [\t ]")
+
 (let ((match (match-pattern script input)))
   (if (not (eq? (string-length input) (peg:end match)))
       (let ((tree (peg:tree match)))

test.sh

@@ -1,3 +1,7 @@
+cat <<EOF
+foobar
+EOF
+
 for file in $(find * -type f)
 do
   if [ "${file}" != "generator.log"\