Pasta80 Pascal-S validator pilot (ported grammar, psc oracle)

grammars/Pasta80/README.md

@@ -0,0 +1,47 @@
+# Pasta80 Pascal-S validator pilot
+
+`pasta80.atg` describes Pascal-S as implemented by Arzu/Terry's
+Coco/R-Turbo-Pascal compiler (1996-97). The reference files
+(`Grammars/Pasta80/pasta80.atg`, identical to `Pascual/pascual.atg`
+modulo its tags line) are written for a newer Coco/R generation:
+attributed rules (`<params>`, `(.. actions ..)`, `SYNC`), so the
+pilot is a mechanical port — actions/attributes stripped by script,
+`<>` restored where the stripper ate the operator — plus hand fixes,
+all diagnosed against `psc` (the Turbo batch interpreter built with
+`fpc -Mtp`) as oracle:
+
+1. `|` empty literal from the eaten `<>` (in `RelOp`).
+2. Strict `Statement { ";" Statement }` lists (block body,
+   `CompStat`, parameter tails) made tolerant.
+3. Duplicate `preal` in `RealConst` merged.
+4. `WriteArg` string-vs-expression conflict merged into
+   `Expression [ ":" ... ]` (after proving `psc` accepts string
+   comparisons, so `StrConst` belongs in `Factor`).
+5. Mandatory `";"` after every record field relaxed to the tolerant
+   list shape.
+6. Missing `CASE` statement added whole (`CASE`/`OF`/`|`/`END`,
+   labels are `pnumber`/`ident`/`pstring`, no ranges, no `ELSE` —
+   each shape probed).
+7. `REPEAT` with `","` separators corrected to `";"` (probed:
+   `psc` takes semicolons, rejects commas).
+8. Bare `READ`/`WRITE` calls: parens made optional (probed).
+
+One benign LL(1) warning family remains (dangling-`ELSE`).
+
+## Build
+
+```sh
+./build.sh        # -> build/Pasta80 (build/ is git-ignored)
+```
+
+Needs `CR` (Coco/R), `gm2 -fiso`, the `parser.frm`/`scanner.frm`
+frames and `FileIO.def/.mod` — all resolved from the environment with
+sensible defaults (`CRFRAMES`, `M2LIB`, `CR`, `GM2`).
+
+## Differential results (Pasta80 vs `psc`)
+
+The PascalS accept battery (22 cases) + `tests/deep.pas` (nested
+routines with `var` params, records, all statements, reals):
+**0 false positives**. Broken mutants (12): **0 missed**, positions
+close. (`i := 1` without `;` and unterminated comments are accepted
+by `psc` too — separator/recovery leniency, correctly skipped.)

grammars/Pasta80/build.sh

@@ -0,0 +1,45 @@
+#!/bin/bash
+# Build the Pasta80 Pascal-S syntax validator from pasta80.atg.
+# Needs: CR (Coco/R V1.53), gm2 -fiso, parser/scanner frames, FileIO.
+# Note: link via the two-step module list; a single-step link trips
+# over pre-existing errors in this gm2 build's own ISO library .defs.
+set -e
+CR="${CR:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+GM2="${GM2:-/home/eric/bin/Modula2/Gm2/bin/gm2}"
+FRAMES="${CRFRAMES:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+M2LIB="${M2LIB:-/home/eric/Projets/Projets-Modula2/MyWork/Theia/GNU-grammar/build}"
+HERE="$(cd "$(dirname "$0")" && pwd)"
+B="$HERE/build"
+rm -rf "$B"
+mkdir -p "$B"
+cp "$HERE/pasta80.atg" "$B/"
+cp "$M2LIB/FileIO.def" "$M2LIB/FileIO.mod" "$B/"
+cd "$B"
+echo "=== CR ==="; CRFRAMES="$FRAMES" "$CR" -m -C pasta80.atg
+echo "=== check: no degenerate code ==="
+if grep -q "IF FALSE\|WHILE FALSE" Pasta80P.mod; then echo "DEGENERATE GENERATION (IF/WHILE FALSE)"; exit 1; fi
+echo "=== patch: EOF check ==="
+python3 - "$B" <<'PYEOF'
+import sys
+b = sys.argv[1]
+s = open(b + '/Pasta80P.mod').read()
+old = '    Pasta80S.Reset; Get;\n    Pasta80;\n\n  END Parse;'
+assert old in s, 'EOF patch pattern missing'
+s = s.replace(old, '    Pasta80S.Reset; Get;\n    IF sym # 0 THEN Pasta80 END;\n    IF sym # 0 THEN SynError(0) END;\n\n  END Parse;')
+open(b + '/Pasta80P.mod', 'w').write(s)
+print('patched')
+PYEOF
+echo "=== compile ==="
+for m in FileIO Pasta80S Pasta80P Pasta80; do "$GM2" -fiso -I . -c "$m.mod"; done
+echo "=== link ==="
+# NOTE: the gen step exits 1 on pre-existing errors in gm2's own
+# ISO library .defs, but still writes a usable modules.lst.
+"$GM2" -fiso -I . -fgen-module-list=modules.lst -o /dev/null FileIO.o Pasta80S.o Pasta80P.o Pasta80.mod || true
+"$GM2" -fiso -I . -fuse-list=modules.lst -o Pasta80 FileIO.o Pasta80S.o Pasta80P.o Pasta80.mod
+echo "=== smoke ==="
+printf 'program hello (input, output);\nbegin\n  writeln(42);\nend.\n' > Hello.pas
+./Pasta80 Hello.pas
+printf 'program t (input, output);\nbegin\nend. GARBAGE\n' > Garbage.pas
+if ./Pasta80 Garbage.pas 2>&1 | grep -q "Incorrect"; then echo "trailing-garbage rejected"; else echo "EOF CHECK FAILED"; exit 1; fi
+./Pasta80 "$HERE/tests/deep.pas"
+rm -f Hello.pas Hello.LST Garbage.pas Garbage.LST "$HERE/tests/deep.LST"

grammars/Pasta80/pasta80.atg

@@ -0,0 +1,330 @@
+(* Pasta80 Pascal-S ATG for Coco/R *)
+(* Ported from Arzu/Terry Coco/R-Turbo Pascal-S (1996-97);
+   actions and attributes stripped for V1.53 *)
+
+COMPILER Pasta80
+IGNORE CASE
+IGNORE CHR(1) .. CHR(32)
+COMMENTS FROM "(*" TO "*)"
+COMMENTS FROM "{" TO "}"
+
+CHARACTERS
+  digit  = "0123456789" .
+  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" .
+  noQuote1 = ANY - "'" - CHR(13) .
+
+TOKENS
+  ident    = letter { letter | digit } .
+  pnumber  = digit { digit } | digit { digit } CONTEXT ( ".." ) .
+  preal    = digit { digit } "." digit { digit }
+           | digit { digit } "." digit { digit } "E" [ "+" | "-" ] digit { digit } .
+  pstring  = "'" { noQuote1 | "''" } "'" .
+
+PRODUCTIONS
+  Pasta80
+    =                             
+      "PROGRAM" Ident
+      [ "(" ident {"," ident }
+        ")"
+      ]
+      Block
+      "."                    
+     .
+
+  Block 
+                                  
+    =                             
+      [ "(" ParameterList
+         ")" ]                    
+      [ ":" Ident             
+      ]
+      ";"
+      {   ConstDecl
+        | TypeDecl
+        | VarDecl
+        | ProcDecl
+      }                           
+      SYNC
+      "BEGIN"                     
+         [ Statement
+           { ";" [ Statement ] } ]
+      "END"
+      .
+
+  Statement
+    =   AssignCallStat
+      | CompStat
+      | CaseStat
+      | IfStat
+      | WhileStat
+      | RepeatStat
+      | ForStat
+      | StandardProc
+      .
+
+  AssignCallStat                  
+    =
+      Ident                   
+      { Selector }
+      ( ":=" Expression  
+        |                         
+          [ ActualParams ]
+                                  
+      )
+      .
+
+  CompStat
+    = "BEGIN" [ Statement { ";" [ Statement ] } ] "END" .
+
+  IfStat                          
+    = "IF" Expression    
+      "THEN" Statement
+      ( "ELSE"                    
+        Statement                 
+      | (* empty *)               
+      )
+      .
+
+  RepeatStat                      
+    = "REPEAT"                    
+        [ Statement { ";" [ Statement ] } ]
+      "UNTIL"
+      Expression         
+      .
+
+  WhileStat                       
+    = "WHILE"                     
+      Expression         
+      "DO"
+      Statement                   
+      .
+
+  ForStat                         
+    = "FOR" Ident             
+      ":=" Expression    
+      ( "TO"                      
+      | "DOWNTO"                  
+      )
+      Expression         
+      "DO"                        
+      Statement                   
+      .
+
+  StandardProc
+    =   "READ"    [ "(" ReadArg {"," ReadArg} ")" ]
+      | "READLN"  [ "(" ReadArg {"," ReadArg} ")" ]
+
+      | "WRITE"   [ "(" WriteArg {"," WriteArg} ")" ]
+      | "WRITELN" [ "(" WriteArg {"," WriteArg} ")" ]
+
+      .
+
+  CaseStat = "CASE" Expression "OF" [ CaseItem { ";" [ CaseItem ] } ] "END" .
+  CaseItem = CaseLabels ":" Statement .
+  CaseLabels = CaseLabel { "," CaseLabel } .
+  CaseLabel = pnumber | ident | pstring .
+
+  ReadArg                         
+    = Ident                   
+      { Selector }             
+      .
+
+  WriteArg = Expression [ ":" Expression [ ":" Expression ] ] .
+
+  Selector          
+    = "." Ident               
+      | "["
+         Expression      
+         { ","
+           Expression    
+         }
+        "]"
+      .
+
+  ActualParams 
+                                  
+    = "("                         
+      Expression
+                                  
+      { ","                       
+        Expression
+                                  
+      }
+      ")"
+      .
+
+  Expression 
+                                  
+    = SimpExpr
+      {  RelOp
+         SimpExpr      
+      }
+      .
+
+  SimpExpr 
+                                  
+      =                           
+      [  "+" | "-"                
+      ]
+      Term             
+      {  AddOp
+         Term          
+      }
+      .
+
+  Term 
+                                  
+    = Factor
+      { MultOp
+        Factor         
+      }
+      .
+
+  Factor 
+                                  
+      =                           
+         Ident                
+
+         ( Selector            
+           { Selector          
+           }
+          | ActualParams
+                                  
+          | (*empty bug fix pdt    *)
+         )
+
+      |  RealConst          
+      |  IntConst           
+      |  ChrConst             
+      | "(" Expression ")"
+      | "NOT" Factor   
+      .
+
+  RelOp 
+      =  "="                      
+      |  "<>"                     
+      |  "<"                      
+      |  "<="                     
+      |  ">"                      
+      |  ">="                     
+      .
+
+  AddOp 
+      =  "+"                      
+      |  "-"                      
+      |  "OR"                     
+      .
+
+  MultOp 
+      =  "DIV"                    
+      |  "MOD"                    
+      |  "AND"                    
+      |  "/"                      
+      |  "*"                      
+      .
+
+  ProcDecl                        
+    = (
+        "PROCEDURE" Ident     
+      | "FUNCTION"  Ident     
+      )                           
+      Block            
+      ";"                         
+      .
+
+  VarDecl 
+                                  
+    = "VAR"
+      {
+         Ident                
+         { "," Ident          
+         }
+         ":" Typ              
+         ";"
+      }
+      .
+
+  ArrayTyp   
+    =                             
+      Const                  
+      ".." Const            
+      (   "," ArrayTyp
+        | "]" "OF" Typ
+      )                           
+      .
+
+  Typ           
+    =                             
+         Ident                
+      |  "ARRAY" "[" ArrayTyp
+      |  "RECORD"
+         [ RecField { ";" [ RecField ] } ]
+         "END"
+      .
+
+  ParameterList 
+    = ParameterItem
+      { ";" [ ParameterItem ] }
+      .
+
+
+  RecField = Ident { "," Ident } ":" Typ .
+  ParameterItem  
+      =
+        ("VAR"                    
+         |                        
+        )
+        Ident                 
+        { "," Ident           
+        }
+        ":"
+        Ident                 
+      .
+
+  ConstDecl                       
+    = "CONST"
+      { Ident                 
+        "="
+        Const                  
+        ";"
+      }
+      .
+
+  TypeDecl                        
+    = "TYPE"
+      { Ident                 
+        "="
+        Typ                   
+        ";"
+      }
+      .
+
+  Const           
+    =                             
+      (
+          ChrConst            
+        | [  "+" | "-"            
+          ]
+          (   Ident           
+            | IntConst        
+            | RealConst       
+          )
+      )
+      .
+
+  Ident            
+    = ident                       
+      .
+
+  IntConst       
+    = pnumber                      
+      .
+
+  RealConst = preal .
+
+
+  ChrConst         
+    = pstring                      
+      .
+
+END Pasta80.

grammars/Pasta80/tests/deep.pas

@@ -0,0 +1,44 @@
+program deep (input, output);
+const n = 10;
+  neg = -5;
+  pi = 3.14159;
+  h = 'h';
+type
+  intarr = array [1..10] of integer;
+  matrix = array [0..1, 0..2] of integer;
+  point = record x, y: integer end;
+var
+  i, j: integer;
+  ch: char;
+  b: boolean;
+  r: real;
+  a: intarr;
+  pt: point;
+function sum(a, b: integer): integer;
+begin
+  sum := a + b
+end;
+function isodd(n: integer): boolean;
+begin
+  isodd := odd(n)
+end;
+procedure fill(var a: intarr; value: integer);
+var k: integer;
+begin
+  for k := 1 to n do a[k] := value
+end;
+begin
+  for i := 1 to n do a[i] := i;
+  while i < n do i := i + 1;
+  repeat
+    case i of
+      1: write(1);
+      2, 3: write(2)
+    end;
+  until i > n;
+  pt.x := sum(1, 2);
+  r := 1.5e-3;
+  b := (i = 1) and (j <> 2) or not b;
+  fill(a, 0);
+  writeln('done')
+end.