From 7d853f8f7ed54c99cc864aa072925a7bd8e735ba Mon Sep 17 00:00:00 2001
From: Alain Zscheile <fogti+devel@ytrizja.de>
Date: Sun, 11 Feb 2024 15:05:23 +0100
Subject: [PATCH] ocaml: forbid duplicate identifiers in patterns

---
 ocaml/libsyntax/syntax.ml | 40 ++++++++++++++++++++++++++++++---------
 1 file changed, 31 insertions(+), 9 deletions(-)

diff --git a/ocaml/libsyntax/syntax.ml b/ocaml/libsyntax/syntax.ml
index 131cd8f..55edf77 100644
--- a/ocaml/libsyntax/syntax.ml
+++ b/ocaml/libsyntax/syntax.ml
@@ -73,6 +73,7 @@ let require ctx parse_inner ps = match parse_inner ps with
       in Yanais_syntax_err (EExpected ctx, ps.file, sp) |> raise
 
 module FieldsReg = Set.Make(String)
+module FieldsReg2 = Map.Make(String)
 
 let parse_record (type a) parse_inner ps = when_got ps (Brace Open) (fun (_, ps) -> (
     (* note: argument accu is reversed *)
@@ -116,15 +117,36 @@ let parse_record (type a) parse_inner ps = when_got ps (Brace Open) (fun (_, ps)
       inner [] FieldsReg.empty ps
   ))
 
-let rec parse_pattern ps = match ps.lt with
-  | (PatOut "", s)::lt ->
-      Some (PatIgnore (ps.file, s),                             { ps with lt; offset = loc_span_end s; })
-  | (PatOut name, s)::lt ->
-      Some (PatName {ident = name; file = ps.file; span = s; }, { ps with lt; offset = loc_span_end s; })
-  | (Brace Open, _)::_ ->
-      let rqp_pattern = require XPattern parse_pattern in
-      Some (require XRecord (parse_record rqp_pattern) ps |> (fun (x, ps) -> (PatRecord x, ps)))
-  | _ -> None
+let rec pattern_exports stk p = match p with
+  | PatIgnore _ -> stk
+  | PatName tgi -> tgi::stk
+  | PatRecord rcd -> List.fold_left (fun stk (_, _, p) -> pattern_exports stk p) stk rcd
+
+let parse_pattern ps =
+  let rec inner ps = match ps.lt with
+    | (PatOut "", s)::lt ->
+        Some (PatIgnore (ps.file, s),                             { ps with lt; offset = loc_span_end s; })
+    | (PatOut name, s)::lt ->
+        Some (PatName {ident = name; file = ps.file; span = s; }, { ps with lt; offset = loc_span_end s; })
+    | (Brace Open, _)::_ ->
+        let rqp_pattern = require XPattern inner in
+        Some (require XRecord (parse_record rqp_pattern) ps |> (fun (x, ps) -> (PatRecord x, ps)))
+    | _ -> None
+  in let rec chk4dups stk reg = match stk with
+    | [] -> None
+    | x::xs ->
+      match FieldsReg2.find_opt x.ident reg with
+        | None -> chk4dups xs (FieldsReg2.add x.ident x reg)
+        (* this retrieves the later entry because we iterate the list in reverse *)
+        | Some orig -> Some orig
+  in match inner ps with
+    | None -> None
+    | Some (ret, ps) ->
+      (* check for duplicates *)
+      let ptexports = pattern_exports [] ret in
+      match chk4dups ptexports FieldsReg2.empty with
+        | None -> Some (ret, ps)
+        | Some { ident; file; span; } -> Yanais_syntax_err (EPatternDupIdent ident, file, span) |> raise
 
 (*
 let parse_expr ps =