From 2a0e85575efff3124be4fb8ba3714ec139462dcf Mon Sep 17 00:00:00 2001
From: Alain Zscheile <fogti+devel@ytrizja.de>
Date: Thu, 15 Feb 2024 18:16:42 +0100
Subject: [PATCH] ocaml: [WIP] TagGroup

---
 ocaml/lib/locale.ml         |  2 ++
 ocaml/libsyntax/lex.ml      |  1 +
 ocaml/libsyntax/literal.ml  |  4 ++++
 ocaml/libsyntax/tagGroup.ml | 31 +++++++++++++++++++++++++++++++
 ocaml/libsyntax/tys.ml      |  4 ++++
 5 files changed, 42 insertions(+)
 create mode 100644 ocaml/libsyntax/tagGroup.ml

diff --git a/ocaml/lib/locale.ml b/ocaml/lib/locale.ml
index d2a0285..8b2ef6d 100644
--- a/ocaml/lib/locale.ml
+++ b/ocaml/lib/locale.ml
@@ -38,6 +38,7 @@ module Bare : LocaleT = struct
     | XRefOf      -> "ref-of"
     | XSelect     -> "selection"
     | XString     -> "string"
+    | XTagGroup   -> "tag-group"
     | XIdent      -> "identifier"
 
   let pp_error fmtp (k,file,s) =
@@ -97,6 +98,7 @@ module En : LocaleT = struct
     | XRefOf      -> "ref-of"
     | XSelect     -> "selection"
     | XString     -> "string"
+    | XTagGroup   -> "tag group"
     | XIdent      -> "identifier"
 
   let pp_error fmtp (k,file,s) =
diff --git a/ocaml/libsyntax/lex.ml b/ocaml/libsyntax/lex.ml
index 7fe8874..b41d431 100644
--- a/ocaml/libsyntax/lex.ml
+++ b/ocaml/libsyntax/lex.ml
@@ -93,6 +93,7 @@ let tokens lx () =
           | "layout" -> Layout
           | "let" -> Let
           | "match" -> Match
+          | "tag_group" -> KTagGroup
           | "\u{03BB}" -> Lambda
           | "\u{039B}" -> TyLambda (* a large lambda *)
           | "\u{03BC}" -> Mu
diff --git a/ocaml/libsyntax/literal.ml b/ocaml/libsyntax/literal.ml
index db3fbb8..1ad78f1 100644
--- a/ocaml/libsyntax/literal.ml
+++ b/ocaml/libsyntax/literal.ml
@@ -33,6 +33,10 @@ let isz_to_str = function
   | IPow x -> Int.shift_left 1 (Char.code x) |> Int.to_string
   | ISize -> "_size"
 
+let isz_to_pow = function
+  | IPow x -> x
+  | ISize -> 16 (* should be a fitting default *)
+
 let str_post loc s = String.sub s loc (String.length s - loc)
 
 let of_string = function
diff --git a/ocaml/libsyntax/tagGroup.ml b/ocaml/libsyntax/tagGroup.ml
new file mode 100644
index 0000000..6468363
--- /dev/null
+++ b/ocaml/libsyntax/tagGroup.ml
@@ -0,0 +1,31 @@
+open Tys
+
+module FieldsReg = Map.Make(String)
+
+(* a tag group, which has an underlying type, and a bunch of key-index pairs *)
+type t = loc_span_full * Literal.int_size * (int FieldsReg.t)
+
+let rev_lookup ival ((_, _, frg): t) =
+  FieldsReg.filter (fun nam -> fun x -> x == ival) frg |> FieldsReg.choose
+
+let parse_opt ps =
+  let rec inner ps (osp, oisz, frg) = match ps.lt with
+    | (DotIdent nam, s)::(LLiteral Literal.LNatural nat, _)::(SemiColon, s3)::lt ->
+        let ps = { ps with lt; offset = loc_span_end s3; } in
+        (match FieldsReg.find_opt nam frg with
+          | None -> inner ps (osp, isz, FieldsReg.add nam nat frg)
+          | Some x -> Yanais_syntax_err (ERecordDupIdent nam, ps.file, s) |> raise)
+    | (Brace Close, s)::lt ->
+        let ps = { ps with lt; offset = loc_span_end s; } in
+        ((osp, oisz, frg), ps)
+    | (k, s)::lt -> Yanais_syntax_err (EExpected XTagGroupItem, ps.file, s) |> raise
+    | [] -> Yanais_syntax_err (EUnexpectedEof XTagGroupItem, ps.file, osp) |> raise
+
+  match ps.lt with
+    | (KTagGroup, s1)::(LLiteral Literal.LIntSize isz, _)::(Brace Open, s3)::lt ->
+        let ps = { ps with lt; offset = loc_span_end s3; } in
+        let acc = ((ps.file, s1), isz, FieldsReg.empty) in
+        Some (inner ps acc)
+    | _ -> None
+
+let parse ps = require XTagGroup parse_opt ps
diff --git a/ocaml/libsyntax/tys.ml b/ocaml/libsyntax/tys.ml
index 29191c5..8a39143 100644
--- a/ocaml/libsyntax/tys.ml
+++ b/ocaml/libsyntax/tys.ml
@@ -47,6 +47,7 @@ type token =
   | Layout
   | Let
   | Match
+  | KTagGroup
 
 type token_ann = token * loc_span
 
@@ -76,6 +77,7 @@ let token_to_string = function
   | Layout     -> "layout"
   | Let        -> "let"
   | Match      -> "match"
+  | KTagGroup  -> "tag_group"
 
 type error_ctx =
   | XComment
@@ -90,6 +92,7 @@ type error_ctx =
   | XRefOf
   | XSelect
   | XString
+  | XTagGroup
   | XIdent
 
 let str_of_ectx = function
@@ -105,6 +108,7 @@ let str_of_ectx = function
   | XRefOf      -> "ref-of"
   | XSelect     -> "selection"
   | XString     -> "string"
+  | XTagGroup   -> "tag group"
   | XIdent      -> "identifier"
 
 type error_kind =