A generic struct's copy prints as (Pair i32 {...}), crosses to C behind a pointer, names each use that made it when refused, settles literal fields at the wider type, and is laid out by stores and restarts that first name it

lib/check.ml

@@ -79,6 +79,16 @@ let rec slot_text = function
   | Sclass c -> c
   | Sopt s -> "(Option " ^ slot_text s ^ ")"
 
+(* Where [sep] first occurs in [m]. *)
+let find_sub m sep =
+  let n = String.length m and k = String.length sep in
+  let rec go i =
+    if i + k > n then None
+    else if String.sub m i k = sep then Some i
+    else go (i + 1)
+  in
+  go 0
+
 (* ── Generic structs ─────────────────────────────────────────────────
    [(defstruct Small [items [$n $t] count i32])] is a template, not a type.
    Its parameters are the sigil names its fields introduce, in the order
@@ -1642,7 +1652,17 @@ and struct_copy env loc name targs =
       restore ();
       Hashtbl.remove env.copies key;
       Hashtbl.remove env.structs key;
-      raise e
+      (* A field refused inside the template says nothing about which use
+         asked for this copy; the note names it, one per level of copies. *)
+      (match e with
+       | Loc.Error d when d.Loc.dloc <> loc ->
+         Loc.raise_diag
+           { d with
+             Loc.notes =
+               d.Loc.notes
+               @ [ Loc.note loc
+                     (Types.to_string (Types.Named key) ^ " is made here") ] }
+       | e -> raise e)
   end
 
 (* Does a struct argument still mention a variable? *)
@@ -1728,12 +1748,12 @@ and resolve_name env ~seen loc n =
      | [ v ] ->
        Loc.failk "check/unbound-type-variable" loc
          "nothing binds the type variable %s — this signature introduces %s, \
-          so write %s here, or a concrete type" n v v
+          so write %s here, or a concrete type" n ("$" ^ v) ("$" ^ v)
      | vars ->
        Loc.failk "check/unbound-type-variable" loc
          "nothing binds the type variable %s — this signature introduces %s, \
           so write one of those here, or a concrete type"
-         n (String.concat " and " vars))
+         n (String.concat " and " (List.map (fun v -> "$" ^ v) vars)))
   else
   match Types.ikind_of_name n with
   | Some k -> Types.Int k
@@ -1769,7 +1789,15 @@ and resolve_name env ~seen loc n =
           ~notes:[ Loc.note g.gloc (n ^ " is declared here") ]
           "%s is generic, and a type only once it is given its arguments: \
            write (%s %s)" n n
-          (String.concat " " (List.map (fun (p, _) -> "$" ^ p) g.gparams))
+          (* Variables are only an answer where a signature binds them; in
+             ordinary code the example is concrete. *)
+          (String.concat " "
+             (List.map
+                (fun (p, is_len) ->
+                   if env.tyvars <> [] then "$" ^ p
+                   else if is_len then "8"
+                   else "i32")
+                g.gparams))
       | _ when Hashtbl.mem env.structs n -> Types.Named n
       (* A data type is [Named] exactly as a struct is: one case in [Types.t]
          covers both, and which table the name is in is what tells them apart.
@@ -4056,7 +4084,7 @@ let rec key_pair env loc (k : Types.t) : Tast.fnref * Tast.fnref =
      to that is still a refusal rather than a guessed pair. *)
   | Types.Var v ->
     Loc.failk "check/generic-map-key" loc
-      "a map keyed by the type variable %s has no hash and no equality here. \
+      "a map keyed by the type variable $%s has no hash and no equality here. \
        Write {:where (hashable? $%s)} at the head of the body, or write the \
        operation in a function over the concrete key type and call that" v v
   | Types.String -> Tast.Rtfn "flan_hash_str", Tast.Rtfn "flan_eq_str"
@@ -6611,12 +6639,37 @@ and generic_ctor ctx ~want loc name given =
       | Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
       | _ -> false
     in
+    (* A literal's own type, the one it has with nothing expected of it. *)
+    let literal_type (a : Ast.expr) =
+      match a.Ast.e with
+      | Ast.Float _ -> Types.Float Types.F64
+      | Ast.UInt _ -> Types.Int Types.U64
+      | Ast.Byte _ -> Types.Int Types.U8
+      | _ -> Types.Int Types.I32
+    in
     let pairs =
       List.filter (fun (_, a) -> not (literal a)) pairs
       @ List.filter (fun (_, a) -> literal a) pairs
     in
+    (* Variables only literals have bound so far: a later literal may widen
+       them, as a generic call's literal arguments meet at the wider type —
+       [(Pair 1 2.5)] is a [(Pair f64)]. *)
+    let lit_only = ref [] in
     List.iter
       (fun ((f : Tast.field), (a : Ast.expr)) ->
+         match f.Tast.fty with
+         | Types.Var v when literal a && not (List.mem_assoc v !subst && not (List.mem v !lit_only)) ->
+           let t = (literal_type a) in
+           (match List.assoc_opt v !subst with
+            | None -> subst := (v, t) :: !subst; lit_only := v :: !lit_only
+            | Some b ->
+              (match Types.join b t with
+               | Some j -> subst := (v, j) :: List.remove_assoc v !subst
+               | None ->
+                 fail a.Ast.loc "%s's .%s is %s here, and this is %s"
+                   (Types.to_string (Types.Named open_key)) f.Tast.fname
+                   (Types.to_string b) (Types.to_string t)))
+         | _ ->
          if open_ty f.Tast.fty
             && not (literal a && subst_ty !subst f.Tast.fty |> open_ty |> not)
          then begin
@@ -6657,7 +6710,13 @@ and generic_ctor ctx ~want loc name given =
                   "%s's $%s is not decided by the fields given here. Name the \
                    type where the value goes, as in (the (%s %s) ...)"
                   name p name
-                  (String.concat " " (List.map (fun (q, _) -> "$" ^ q) g.gparams)))
+                  (String.concat " "
+                     (List.map
+                        (fun (q, is_len) ->
+                           if env.tyvars <> [] then "$" ^ q
+                           else if is_len then "8"
+                           else "i32")
+                        g.gparams)))
            g.gparams
        in
        struct_copy env loc name targs)
@@ -11946,7 +12005,7 @@ and generic_call ctx ~want loc name vars pats pret args =
             | Some (Types.Var v) when not (declares ctx.env.tvpreds v p.Ast.pname) ->
               Loc.failk "check/predicate-not-carried" loc
                 "%s is written {:where (%s $%s)}, and this call passes the \
-                 type variable %s, which nothing here declares %s. Add \
+                 type variable $%s, which nothing here declares %s. Add \
                  {:where (%s $%s)} to this function's own clause"
                 name p.Ast.pname p.Ast.pvar v p.Ast.pname p.Ast.pname v
             | Some t when not (open_ty t) && not (pred_holds p.Ast.pname t) ->
@@ -12064,17 +12123,29 @@ and instantiate env loc gname vars subst cparams cret =
              asked for the copy, and the prelude's line comes along as a
              note. *)
           | Loc.Error d when in_prelude d.Loc.dloc && not (in_prelude loc) ->
+            (* Only the reason comes along. The rest of the body's message is
+               a fix to the body, which the caller cannot make. *)
+            let reason =
+              let cut sep m =
+                match find_sub m sep with
+                | Some i -> String.sub m 0 i
+                | None -> m
+              in
+              cut ". " (cut " — " d.Loc.dmsg)
+            in
             Loc.Error
               (Loc.sort_notes
                  { d with
                    Loc.dloc = loc;
                    dmsg =
-                     Printf.sprintf "%s cannot be made at %s. In its body: %s"
+                     Printf.sprintf
-                       gname (at ()) d.Loc.dmsg;
+                       "%s cannot be made at %s: its body in the prelude does \
+                        not compile at that type. Pass a value of a type it \
+                        takes, or write the operation here"
+                       gname (at ());
                    notes =
                      d.Loc.notes
-                     @ [ Loc.note d.Loc.dloc
+                     @ [ Loc.note d.Loc.dloc ("in the prelude, " ^ reason) ];
-                           "the refusal is here, in the prelude" ];
                    expansion = None })
           | Loc.Error d when d.Loc.dloc <> loc ->
             Loc.Error

lib/dev.ml

@@ -1920,13 +1920,19 @@ let defs t =
    text about the type and never touches the program. *)
 let layout t ~ty =
   let structs = t.session.Session.program.Tast.structs in
+  (* A generic struct's copy answers to the spelling a printed value's head
+     gives it, [Pair i32], and to its type's, [(Pair i32)], as well as to its
+     key. *)
+  let names (s : Tast.structure) =
+    [ s.Tast.sname; Types.struct_head s.Tast.sname;
+      Types.to_string (Types.Named s.Tast.sname) ]
+  in
   match
-    List.find_opt (fun (s : Tast.structure) -> String.equal s.Tast.sname ty)
+    List.find_opt (fun (s : Tast.structure) -> List.mem ty (names s)) structs
-      structs
   with
   | Some s ->
     ok
-      [ ":type " ^ Wire.quote s.Tast.sname;
+      [ ":type " ^ Wire.quote (Types.to_string (Types.Named s.Tast.sname));
         ":fields "
         ^ Wire.list
             (List.map

lib/parse.ml

@@ -73,6 +73,16 @@ let no_pattern (f : Form.t) =
 
 (* ── Type expressions ──────────────────────────────────────────────── *)
 
+(* A type constructor's spelling: its last segment starts with a capital. *)
+let capitalised_name name =
+  let base =
+    match String.rindex_opt name '/' with
+    | Some i -> String.sub name (i + 1) (String.length name - i - 1)
+    | None -> name
+  in
+  base <> "" && Char.uppercase_ascii base.[0] = base.[0]
+  && Char.lowercase_ascii base.[0] <> base.[0]
+
 let rec texpr (f : Form.t) : Ast.texpr =
   let mk t = { Ast.t; tloc = f.loc } in
   match f.v with
@@ -135,23 +145,41 @@ let rec texpr (f : Form.t) : Ast.texpr =
      | [ { v = Vec params; _ }; ret ] ->
        mk (Ast.Tfn (env, List.map texpr params, texpr ret))
      | _ -> fail f "a function type is (%s [T ...] R)" which)
-  | List ({ v = Sym name; _ } :: args) when args <> [] ->
+  | List ({ v = Sym name; _ } :: args)
+    when args <> [] || capitalised_name name ->
     (* An integer argument is a generic struct's length, and a type
        constructor is capitalised. A lowercase head is a body form in the
        return slot — (+ x 1) — and its integer is the type parser's reason to
        give up, which is the refusal that slot is built on. *)
-    let capitalised =
+    let capitalised = capitalised_name name in
-      let base =
+    (* Integer arithmetic over literals is a length too — [(Small (+ 4 4)
-        match String.rindex_opt name '/' with
+       i32)] — folded here, since nothing later reads it as a value. *)
-        | Some i -> String.sub name (i + 1) (String.length name - i - 1)
+    let rec fold (a : Form.t) =
-        | None -> name
+      match a.v with
-      in
+      | Int n -> Some n
-      base <> "" && Char.uppercase_ascii base.[0] = base.[0]
+      | List ({ v = Sym (("+" | "-" | "*") as op); _ } :: (_ :: _ as xs)) ->
-      && Char.lowercase_ascii base.[0] <> base.[0]
+        let vs = List.map fold xs in
+        if List.for_all Option.is_some vs then
+          let vs = List.map Option.get vs in
+          match op, vs with
+          | "-", [ x ] -> Some (Int64.neg x)
+          | "+", v :: rest -> Some (List.fold_left Int64.add v rest)
+          | "-", v :: rest -> Some (List.fold_left Int64.sub v rest)
+          | "*", v :: rest -> Some (List.fold_left Int64.mul v rest)
+          | _ -> None
+        else None
+      | _ -> None
     in
     let arg (a : Form.t) =
-      match a.v with
+      match a.v, fold a with
-      | Int n when capitalised -> { Ast.t = Ast.Tlen n; tloc = a.loc }
+      | _, Some n when capitalised -> { Ast.t = Ast.Tlen n; tloc = a.loc }
+      | List _, None when capitalised ->
+        (try texpr a with
+         | Loc.Error _ ->
+           fail a
+             "%s is not a type or a length. An argument here is a type, or a \
+              length: an integer, a constant's name or a length variable"
+             (Form.to_string a))
       | _ -> texpr a
     in
     mk (Ast.Tapp (name, List.map arg args))

lib/render.ml

@@ -333,7 +333,7 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
                    @ render c (depth + 1) v)
                 shown)
          in
-         [ do_ ((lit ("(" ^ n ^ " {") :: parts)
+         [ do_ ((lit ("(" ^ Types.struct_head n ^ " {") :: parts)
                 @ (if List.length fields > max_span then [ lit " ..." ] else [])
                 @ [ lit "})" ]) ])
     (* A fixed array's length is in its type, so it unrolls — capped, because

lib/session.ml

@@ -1543,7 +1543,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
   let loc = fn.Tast.floc in
   let extra = ref [] and nslots = ref 0 in
   let c =
-    { Render.structs = t.program.Tast.structs;
+    { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
       datas = t.program.Tast.datas;
       unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
@@ -1655,7 +1655,7 @@ let render_condition t ~(st : Tast.structure) : change * (string * string) list
   let loc = Loc.unknown in
   let extra = ref [] and nslots = ref 0 in
   let c =
-    { Render.structs = t.program.Tast.structs;
+    { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
       datas = t.program.Tast.datas;
       unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
@@ -1916,7 +1916,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
     | Some name ->
       let extra = ref [] and nslots = ref 0 in
       let c =
-        { Render.structs = t.program.Tast.structs;
+        { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
           datas = t.program.Tast.datas;
           unions = t.program.Tast.unions;
           enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
@@ -2233,7 +2233,7 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
             in
             let extra = ref [] and nslots = ref (Array.length base) in
             let c =
-              { Render.structs = t.program.Tast.structs;
+              { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
                 datas = t.program.Tast.datas;
                 unions = t.program.Tast.unions;
                 enums =
@@ -2270,11 +2270,15 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
                      Array.append bnames
                        (Array.make (List.length !extra) None) }
                in
+               (* A struct copy the values named first, laid out in this
+                  module and kept, as [eval_expr] keeps one. *)
+               let copies = Check.fresh_copies t.env t.program.Tast.structs in
                let program =
                  { t.program with
                    Tast.fns =
                      t.program.Tast.fns @ fresh @ claim_lifted t lmark tname
                      @ [ thunk ];
+                   structs = t.program.Tast.structs @ copies;
                    externs = t.program.Tast.externs @ externs }
                in
                let ir =
@@ -2287,7 +2291,9 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
                   [eval_expr] says why, and the caller takes the same [held]
                   around this that it takes around one. *)
                t.program <-
-                 { t.program with Tast.fns = t.program.Tast.fns @ fresh };
+                 { t.program with
+                   Tast.fns = t.program.Tast.fns @ fresh;
+                   structs = t.program.Tast.structs @ copies };
                Ok
                  ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] },
                   where, Types.to_string shown.Tast.ty))))
@@ -2359,7 +2365,7 @@ let arm_restart ?(origin = "<restart>") t ~index ~(params : Types.t list)
   in
   let extra = ref [] and nslots = ref (Array.length base) in
   let c =
-    { Render.structs = t.program.Tast.structs;
+    { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
       datas = t.program.Tast.datas;
       unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
@@ -2400,17 +2406,22 @@ let arm_restart ?(origin = "<restart>") t ~index ~(params : Types.t list)
         slots = Array.append base (Array.of_list (List.rev !extra));
         snames = Array.append bnames (Array.make (List.length !extra) None) }
     in
+    let copies = Check.fresh_copies t.env t.program.Tast.structs in
     let program =
       { t.program with
         Tast.fns =
           t.program.Tast.fns @ fresh @ claim_lifted t lmark tname @ [ thunk ];
+        structs = t.program.Tast.structs @ copies;
         externs = t.program.Tast.externs @ externs }
     in
     let ir =
       redefinition t ~call:tname program
         ~fns:(List.map (fun (f : Tast.fn) -> f.Tast.name) fresh @ [ tname ])
     in
-    t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
+    t.program <-
+      { t.program with
+        Tast.fns = t.program.Tast.fns @ fresh;
+        structs = t.program.Tast.structs @ copies };
     Ok
       ({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] },
        List.map Types.to_string params)
@@ -2443,7 +2454,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
   let loc = Loc.unknown in
   let extra = ref [] and nslots = ref 0 in
   let c =
-    { Render.structs = t.program.Tast.structs;
+    { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
       datas = t.program.Tast.datas;
       unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
@@ -2564,7 +2575,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
      appended past [base] and collected here to size the frame below. *)
   let extra = ref [] and nslots = ref (Array.length base) in
   let c =
-    { Render.structs = t.program.Tast.structs;
+    { Render.structs = t.program.Tast.structs @ Check.fresh_copies t.env t.program.Tast.structs;
       datas = t.program.Tast.datas;
       unions = t.program.Tast.unions;
       enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];

lib/shim.ml

@@ -177,6 +177,106 @@ let prim_cty = function
   | "bool" -> Some "bool"
   | _ -> None
 
+(* ── Generic structs ──────────────────────────────────────────────────
+   A defstruct whose fields introduce [$t] is a template, and C only ever sees
+   one of its copies: the fields with the arguments written in, laid out the
+   way [Check] lays the same copy out. The copy is registered here under its
+   written spelling, [(G u8)], which [ctype_name] turns into a C name. *)
+
+let sigil n = n <> "" && n.[0] = '$'
+let bare n = if sigil n then String.sub n 1 (String.length n - 1) else n
+
+(* A template's parameters, in the order its fields first introduce them, and
+   whether each is a length — [Check]'s reading, repeated over the AST
+   because this runs before [Check] does. *)
+let rec template_params ?(fuel = 16) env n =
+  match Hashtbl.find_opt env.structs n with
+  | None -> []
+  | Some fs ->
+    let acc = ref [] in
+    let add m is_len =
+      if sigil m && not (List.mem_assoc (bare m) !acc) then
+        acc := (bare m, is_len) :: !acc
+    in
+    let rec walk (t : Ast.texpr) =
+      match t.Ast.t with
+      | Ast.Tname m -> add m false
+      | Ast.Tslice (_, e) -> walk e
+      | Ast.Tarray (Ast.Lname m, e) -> add m true; walk e
+      | Ast.Tarray (_, e) -> walk e
+      | Ast.Tmap (k, v) -> walk k; walk v
+      | Ast.Tapp (h, args) ->
+        let kinds =
+          if fuel = 0 || String.equal h n then []
+          else List.map snd (template_params ~fuel:(fuel - 1) env h)
+        in
+        if List.length kinds = List.length args then
+          List.iter2
+            (fun is_len (a : Ast.texpr) ->
+               match a.Ast.t with
+               | Ast.Tname m when is_len -> add m true
+               | _ -> walk a)
+            kinds args
+        else List.iter walk args
+      | Ast.Tfn (_, ps, r) -> List.iter walk ps; walk r
+      | Ast.Tlen _ -> ()
+    in
+    List.iter (fun (f : Ast.field) -> walk f.Ast.fty) fs;
+    List.rev !acc
+
+let rec source (t : Ast.texpr) =
+  match t.Ast.t with
+  | Ast.Tname n -> n
+  | Ast.Tlen n -> Int64.to_string n
+  | Ast.Tapp (n, args) ->
+    Printf.sprintf "(%s %s)" n (String.concat " " (List.map source args))
+  | Ast.Tslice (c, e) -> Printf.sprintf "[%s%s]" (if c then "const " else "") (source e)
+  | Ast.Tarray (Ast.Lint n, e) -> Printf.sprintf "[%Ld %s]" n (source e)
+  | Ast.Tarray (Ast.Lname n, e) -> Printf.sprintf "[%s %s]" n (source e)
+  | Ast.Tmap (k, v) -> Printf.sprintf "(Map %s %s)" (source k) (source v)
+  | Ast.Tfn (env, ps, r) ->
+    Printf.sprintf "(%s [%s] %s)" (if env then "Fn" else "CFn")
+      (String.concat " " (List.map source ps)) (source r)
+
+(* The copy of template [n] at [args], registered and named. *)
+let copy env ~loc n (args : Ast.texpr list) =
+  let ps = template_params env n in
+  if List.length ps <> List.length args then
+    fail loc "%s takes %d argument%s, and this gives %d" n (List.length ps)
+      (if List.length ps = 1 then "" else "s") (List.length args);
+  let key = source { Ast.t = Ast.Tapp (n, args); tloc = loc } in
+  if not (Hashtbl.mem env.structs key) then begin
+    let sub = List.combine (List.map fst ps) args in
+    let rec go (t : Ast.texpr) =
+      let k =
+        match t.Ast.t with
+        | Ast.Tname m when List.mem_assoc (bare m) sub ->
+          (List.assoc (bare m) sub).Ast.t
+        | Ast.Tname _ | Ast.Tlen _ -> t.Ast.t
+        | Ast.Tslice (c, e) -> Ast.Tslice (c, go e)
+        | Ast.Tarray (Ast.Lname m, e) when List.mem_assoc (bare m) sub ->
+          let l =
+            match (List.assoc (bare m) sub).Ast.t with
+            | Ast.Tlen k -> Ast.Lint k
+            | Ast.Tname c -> Ast.Lname c
+            | _ -> fail loc "%s's $%s is a length" n (bare m)
+          in
+          Ast.Tarray (l, go e)
+        | Ast.Tarray (l, e) -> Ast.Tarray (l, go e)
+        | Ast.Tmap (k, v) -> Ast.Tmap (go k, go v)
+        | Ast.Tapp (h, a) -> Ast.Tapp (h, List.map go a)
+        | Ast.Tfn (b, ps, r) -> Ast.Tfn (b, List.map go ps, go r)
+      in
+      { t with Ast.t = k }
+    in
+    Hashtbl.replace env.structs key
+      (List.map (fun (f : Ast.field) -> { f with Ast.fty = go f.Ast.fty })
+         (Hashtbl.find env.structs n))
+  end;
+  key
+
+let is_template env n = template_params env n <> []
+
 (* [needed] collects the structs whose typedefs this signature pulls in, in the
    order they were first met. Order is the program's and never a hash fold's:
    the object cache keys on the generated text, so a reordering would be a
@@ -184,6 +284,14 @@ let prim_cty = function
 let rec cty env ~needed ~loc ~what (t : Ast.texpr) : string =
   let t = unalias env t in
   match t.Ast.t with
+  | Ast.Tname n when Hashtbl.mem env.structs n && is_template env n ->
+    fail loc "%s is %s, a generic struct, which is a type only at its \
+              arguments — write them, as in (%s %s)" what n n
+      (String.concat " "
+         (List.map (fun (_, l) -> if l then "8" else "i32")
+            (template_params env n)))
+  | Ast.Tapp (n, args) when Hashtbl.mem env.structs n && is_template env n ->
+    cty env ~needed ~loc ~what { t with Ast.t = Ast.Tname (copy env ~loc n args) }
   | Ast.Tname n ->
     (match prim_cty n with
      | Some c -> c
@@ -269,6 +377,14 @@ let classify env ~needed ~loc ~what (t : Ast.texpr) =
   let t' = unalias env t in
   match t'.Ast.t with
   | Ast.Tname "string" -> (Pstr, "const char *")
+  (* A copy crosses behind a pointer only: by value, the Flan half this
+     generator writes would have to spell the copy's type, and it builds its
+     wrapper from struct names. *)
+  | Ast.Tapp (n, _) when Hashtbl.mem env.structs n && is_template env n ->
+    fail loc
+      "%s is %s, a generic struct's copy, which crosses to C behind a pointer \
+       only — declare (Ptr %s) and let the C side read it"
+      what (source t') (source t')
   | Ast.Tname n when Hashtbl.mem env.structs n ->
     ignore (cty env ~needed ~loc ~what t');
     (Pstruct n, ctype_name n)
@@ -546,6 +662,8 @@ let typedefs env needed =
         (fun (f : Ast.field) ->
            match (unalias env f.Ast.fty).Ast.t with
            | Ast.Tname m when Hashtbl.mem env.structs m -> define m
+           | Ast.Tapp (m, args) when Hashtbl.mem env.structs m && is_template env m ->
+             define (copy env ~loc:f.Ast.floc m args)
            | _ -> ())
         fs;
       Printf.bprintf b "struct %s_s {  /* %s */\n" (ctype_name n) n;

lib/types.ml

@@ -229,6 +229,15 @@ let rec equal a b =
    and then only in how a message spells it. *)
 let display : (string, string) Hashtbl.t = Hashtbl.create 16
 
+(* A struct's name as a printed value's head: its own name, or for a generic
+   struct's copy the template and its arguments, [Pair i32] — so a value
+   prints as [(Pair i32 {.a 1 .b 2})], the way its type is written. *)
+let struct_head n =
+  match Hashtbl.find_opt display n with
+  | Some d when String.length d >= 2 && d.[0] = '(' ->
+    String.sub d 1 (String.length d - 2)
+  | _ -> n
+
 let rec to_string = function
   | Int k -> ikind_name k
   | Float k -> fkind_name k

test/programs/generic-struct.flan

@@ -83,7 +83,8 @@
     (let [p (Pair 1 2)
           q (swapped p)
           r (swapped (Pair {.a 1.5 .b 2.5}))]
-      (println (.a q) (.b q) (.a r) (.b r)))
+      (println (.a q) (.b q) (.a r) (.b r))
+      (println q (Pair 1 2.5)))
     (let [c (the (Node i64) {.v 3})
           b (Node 2 (Some (addr c)))
           a (Node 1 (Some (addr b)))]

test/test_acceptance.ml

@@ -3471,7 +3471,8 @@ let () =
        evaluated once: the walk reads an option's tag and then its payload,
        and each read used to make the call again. *)
     let generic_struct_out =
-      "60 3 4\nfalse 7.5 3\n(some 3.5) (some 2.5) 1\n2 1 2.5 1.5\n6\n\
+      "60 3 4\nfalse 7.5 3\n(some 3.5) (some 2.5) 1\n2 1 2.5 1.5\n\
+       (Pair i32 {.a 2 .b 1}) (Pair f64 {.a 1 .b 2.5})\n6\n\
        0 1 2\n3 2\n6\n6 3\n(some 34) none 15\n"
     in
     outputs "generic structs" "programs/generic-struct.flan" generic_struct_out;
@@ -4229,6 +4230,36 @@ level "1"
         end
     in
     let v2 = "(defstruct Vector2 [x f32  y f32])\n" in
+
+    (* A generic struct's copy crosses behind a pointer, as a typedef of its
+       own with the arguments written in, and one held by value inside a
+       struct is defined before that struct. clang reads the text, so the
+       typedef is C and not only a spelling. *)
+    let gsrc =
+      "(defstruct G [x $t  count i32])\n\
+       (defstruct O [v i32  inner (G u8)])\n\
+       (declare-c c-g [s (Ptr (G u8))] i32 \"c_g\")\n\
+       (declare-c c-o [o (Ptr O)] i32 \"c_o\")\n"
+    in
+    shim_case "declare-c: a generic struct's copy crosses behind a pointer" gsrc
+      [ "/* (G u8) */\n  uint8_t x;\n  int32_t count;\n"; "inner;\n" ];
+    (match shim_of gsrc with
+     | c ->
+       let file = Filename.temp_file "flan-shim-generic" ".c" in
+       let oc = open_out file in
+       output_string oc c;
+       close_out oc;
+       if Sys.command (Printf.sprintf "clang -fsyntax-only %s" (Filename.quote file)) <> 0
+       then begin
+         incr failures;
+         print_endline "FAIL  declare-c: a generic struct's copy is C clang accepts"
+       end;
+       Sys.remove file
+     | exception Loc.Error _ -> ());
+    shim_refuses "declare-c: a generic struct's copy by value"
+      "(defstruct G [x $t])\n(declare-c c-v [s (G u8)] i32 \"c_v\")"
+      "crosses to C behind a pointer only";
+
     let img =
       "(defstruct Image [data (Ptr u8)  width i32  height i32])\n"
     in

test/test_dev.ml

@@ -628,6 +628,28 @@ let () =
        | Some { Form.v = Form.Sym "t"; _ } -> ()
        | _ -> fail "an expression against the park reported the program live");
 
+      (* A generic struct's copy prints the way its type is written, with the
+         arguments after the template's name, and [layout] answers to that
+         spelling. *)
+      let r =
+        request c
+          "(:op \"eval\" :code \"(defstruct GPair [a $t b $t])\" :file \"/tmp/buf.flan\")"
+      in
+      if status r <> "ok" then
+        fail "a generic struct at the daemon: %s"
+          (Option.value ~default:(status r) (Wire.string_field r "message"));
+      let r =
+        request c
+          "(:op \"eval-expr\" :code \"(GPair 1 2)\" :file \"/tmp/buf.flan\")"
+      in
+      if Wire.string_field r "value" <> Some "(GPair i32 {.a 1 .b 2})" then
+        fail "a generic struct's copy printed as %s"
+          (Option.value ~default:(status r) (Wire.string_field r "value"));
+      let r = request c "(:op \"layout\" :type \"GPair i32\")" in
+      if Wire.string_field r "type" <> Some "(GPair i32)" then
+        fail "layout of a copy by its printed head: %s"
+          (Option.value ~default:(status r) (Wire.string_field r "message"));
+
       (* And the half that needs the process rather than only the compiler.
          [extra] is a global this session introduced and the first run left at
          105 — the third reload's [step] does not touch it — so this is the

test/test_flan.ml

@@ -6044,6 +6044,7 @@ let () =
      check "a prelude copy's refusal is at the user's call"
        (d.Loc.dloc.Loc.file <> Prelude.file
         && contains d.Loc.dmsg "filter cannot be made at $t = (Vec u8)"
+        && not (contains d.Loc.dmsg "clone")
         && List.exists
              (fun (n : Loc.note) -> n.Loc.nloc.Loc.file = Prelude.file)
              d.Loc.notes));
@@ -6720,13 +6721,13 @@ let () =
      bound, because inside a signature that introduces one the mistake is
      nearly always the second spelling of the first. *)
   rejects_check "vec-new over a sigil that names no variable in scope"
-    ~needle:"this signature introduces t, so write t here"
+    ~needle:"this signature introduces $t, so write $t here"
     "(defn f [x $t] i32 (do x (let [v (vec-new $u)] (free v) 0)))";
   rejects_check "and a cast over one tells the same story"
-    ~needle:"this signature introduces t, so write t here"
+    ~needle:"this signature introduces $t, so write $t here"
     "(defn f [x i32  d $t] $t {:where (numeric? $t)} (do d ($u x)))";
   rejects_check "two variables in scope are both named"
-    ~needle:"introduces t and u, so write one of those"
+    ~needle:"introduces $t and $u, so write one of those"
     "(defn f [a $t  b $u] i32 (do a b (let [v (vec-new $w)] (free v) 0)))";
   (* Where no variable is in scope there is none to name, and the answer is
      the rule: a sigil binds, and only a defn signature is a binding site. *)
@@ -6795,6 +6796,40 @@ let () =
      (defn main [] i32 (f (Pair 1 2)))";
   accepts "a copy wanted where it is built takes its type from there"
     "(defstruct Pair [a $t b $t]) (defn f [] (Pair i64) (Pair 1 2))";
+  (* A copy whose field is refused names each use that asked for it. *)
+  (match
+     checked
+       "(defstruct Box [f $t]) (defstruct Outer [b (Box $w)]) \
+        (defn go [g (Fn [i32] i32)] i32 \
+          (.x (the (Outer (Fn [i32] i32)) (zeroed))) 0)"
+   with
+   | _ -> check "a copy with a zeroed function field is refused" false
+   | exception Loc.Error d ->
+     let notes = List.map (fun (n : Loc.note) -> n.Loc.nmsg) d.Loc.notes in
+     check "a refused copy names each use that made it"
+       (List.mem "(Box (Fn [i32] i32)) is made here" notes
+        && List.mem "(Outer (Fn [i32] i32)) is made here" notes));
+  rejects_check "a bare generic struct in ordinary code suggests real arguments"
+    ~needle:"write (Pair i32)"
+    "(defstruct Pair [a $t b $t]) (defn main [] i32 (let [p (the Pair (zeroed))] 0))";
+  rejects_check "a generic struct applied to nothing"
+    ~needle:"Pair takes 1 argument, (Pair $t), and this gives 0"
+    "(defstruct Pair [a $t b $t]) \
+     (defn main [] i32 (let [p (the (Pair) (zeroed))] 0))";
+  rejects_check "a length argument that is not one"
+    ~needle:"(+ n 1) is not a type or a length"
+    "(defstruct Small [items [$n $t] count i32]) \
+     (defn main [] i32 (let [n 3 p (the (Small (+ n 1) i32) (zeroed))] 0))";
+  accepts "a length argument of literal arithmetic is folded"
+    "(defstruct Small [items [$n $t] count i32]) \
+     (defn main [] i32 (let [p (the (Small (+ 1 2) i32) (zeroed))] \
+       (length (.items p))))";
+  accepts "two literal fields meet at the wider type"
+    "(defstruct Pair [a $t b $t]) \
+     (defn f [] f64 (let [p (Pair 1 2.5)] (+ (.a p) (.b p))))";
+  rejects_check "a callee's predicate names the caller's variable with its $"
+    ~needle:"passes the type variable $t, which nothing here declares ordered?"
+    "(defn f [s [$t]] () (sort s))";
   accepts "a defonce of a generic struct's copy"
     "(defstruct Pair [a $t b $t]) (defonce g (Pair i32)) \
      (defn main [] i32 (.a g))";

test/test_session.ml

@@ -374,6 +374,56 @@ let () =
    | exception Loc.Error { Loc.dmsg = m; _ } ->
      fail "an expression building a generic struct was refused: %s" m);
 
+  (* And the same for the other two modules the break loop builds out of
+     typed-in values: a store into a frame slot, and a restart's arguments.
+     A copy first named in one of them is laid out there and kept. *)
+  (let keeps t what =
+     List.exists
+       (fun (s : Tast.structure) -> String.equal s.Tast.sname what)
+       t.Session.program.Tast.structs
+   in
+   let lays_out (c : Session.change) what =
+     has c.Session.ir ("%\"" ^ what ^ "\" = type")
+   in
+   let st, _ = Session.create ~file:"programs/reload.flan" () in
+   (match Session.eval st "(defstruct Pair [a $t b $t])" with
+    | _ -> ()
+    | exception Loc.Error { Loc.dmsg = m; _ } -> fail "Pair: %s" m);
+   (match Session.eval st "(defn holder [] i64 (let [x (the i64 0)] x))" with
+    | _ -> ()
+    | exception Loc.Error { Loc.dmsg = m; _ } -> fail "holder: %s" m);
+   let fn =
+     List.find (fun (f : Tast.fn) -> f.Tast.name = "holder")
+       st.Session.program.Tast.fns
+   in
+   let slot =
+     let r = ref (-1) in
+     Array.iteri (fun i n -> if n = Some "x" then r := i) fn.Tast.snames;
+     !r
+   in
+   (match
+      Session.write_slot st ~frame:0 ~fn ~slot ~path:[]
+        ~edits:[ ([], "(.a (Pair (the i64 5) 6))") ]
+    with
+    | Ok (c, _, _) ->
+      if not (lays_out c "Pair-i64") then
+        fail "a store's module did not carry the struct copy its value made";
+      if not (keeps st "Pair-i64") then
+        fail "the session did not keep the struct copy a store made"
+    | Error why -> fail "a store building a generic struct was refused: %s" why
+    | exception Loc.Error { Loc.dmsg = m; _ } ->
+      fail "a store building a generic struct was refused: %s" m);
+   match
+     Session.arm_restart st ~index:0 ~params:[ Types.Int Types.U16 ]
+       ~codes:[ "(.b (Pair (the u16 5) 6))" ]
+   with
+   | Ok (c, _) ->
+     if not (lays_out c "Pair-u16") then
+       fail "a restart's module did not carry the struct copy its argument made"
+   | Error why -> fail "a restart building a generic struct was refused: %s" why
+   | exception Loc.Error { Loc.dmsg = m; _ } ->
+     fail "a restart building a generic struct was refused: %s" m);
+
   (* The other half of "a refusal costs nothing", and the half that used to be
      missing: a form can check and *then* fail, in the build or at the agent,
      and the session that already accepted it has no way to hear about it