Source file circuit.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
open Plompiler.Csir
module Gates =
  Custom_gates.Make ( Polynomial_protocol)
let () = assert (List.length CS.all_selectors = Gates.nb_custom_gates - 1 + 2)
let gates_to_string m =
  SMap.fold
    (fun k v s ->
      s ^ k ^ " " ^ String.concat "," (List.map Scalar.to_string v) ^ "\n")
    m ""
module Circuit : sig
  type t = private {
    wires : int array SMap.t;
    gates : Scalar.t array SMap.t;
    tables : Scalar.t array list list;
    public_input_size : int;
    circuit_size : int;
    nb_wires : int;
    table_size : int;
    nb_lookups : int;
    ultra : bool;
  }
  val make_wires :
    a:int list ->
    b:int list ->
    c:int list ->
    ?d:int list ->
    ?e:int list ->
    ?f:int list ->
    ?g:int list ->
    ?h:int list ->
    unit ->
    int list SMap.t
  val make_gates :
    ?qc:Scalar.t list ->
    ?ql:Scalar.t list ->
    ?qr:Scalar.t list ->
    ?qo:Scalar.t list ->
    ?qlg:Scalar.t list ->
    ?qrg:Scalar.t list ->
    ?qog:Scalar.t list ->
    ?qm:Scalar.t list ->
    ?qx2b:Scalar.t list ->
    ?qx5a:Scalar.t list ->
    ?qx5c:Scalar.t list ->
    ?qecc_ws_add:Scalar.t list ->
    ?qecc_ed_add:Scalar.t list ->
    ?q_plookup:Scalar.t list ->
    ?q_table:Scalar.t list ->
    unit ->
    Scalar.t list SMap.t
  val make :
    wires:int list SMap.t ->
    gates:Scalar.t list SMap.t ->
    ?tables:Scalar.t array list list ->
    public_input_size:int ->
    unit ->
    t
  val get_nb_of_constraints : t -> int
  
  val get_selectors : t -> string list
  val sat : CS.t -> Table.t list -> Scalar.t array -> bool
  val to_plonk : public_input_size:int -> ?tables:Table.t list -> CS.t -> t
end = struct
  type t = {
    wires : int array SMap.t;
    gates : Scalar.t array SMap.t;
    tables : Scalar.t array list list;
    public_input_size : int;
    circuit_size : int;
    nb_wires : int;
    table_size : int;
    nb_lookups : int;
    ultra : bool;
  }
  let get_selectors circuit = List.map fst (SMap.bindings circuit.gates)
  let make_wires ~a ~b ~c ?(d = []) ?(e = []) ?(f = []) ?(g = []) ?(h = []) () =
    
    let wire_map = SMap.of_list [ ("a", a); ("b", b); ("c", c) ] in
    let add_map map (label, l) = if l = [] then map else SMap.add label l map in
    List.fold_left add_map wire_map
      [ ("d", d); ("e", e); ("f", f); ("g", g); ("h", h) ]
  let make_gates ?(qc = []) ?(ql = []) ?(qr = []) ?(qo = []) ?(qlg = [])
      ?(qrg = []) ?(qog = []) ?(qm = []) ?(qx2b = []) ?(qx5a = []) ?(qx5c = [])
      ?(qecc_ws_add = []) ?(qecc_ed_add = []) ?(q_plookup = []) ?(q_table = [])
      () =
    
    let gate_list =
      CS.q_list ~qc ~ql ~qr ~qo ~qlg ~qrg ~qog ~qm ~qx2b ~qx5a ~qx5c
        ~qecc_ws_add ~qecc_ed_add ~q_plookup ()
    in
    let add_map map (label, q) =
      match q with
      | [] -> map
      | l -> if List.for_all Scalar.is_zero l then map else SMap.add label q map
    in
    let base =
      if q_table = [] then SMap.empty else SMap.singleton "q_table" q_table
    in
    List.fold_left add_map base gate_list
  let verify_name name i =
    assert (i < 26);
    let alphabet = "abcdefghijklmnopqrstuvwxyz" in
    let letter_i = alphabet.[i] in
    let msg =
      Printf.sprintf "%d-th wire must be named '%c' (current name is '%s')." i
        letter_i name
    in
    if String.length name <> 1 then raise (Invalid_argument msg)
    else if Char.equal name.[0] letter_i then ()
    else raise (Invalid_argument msg)
  
  let make ~wires ~gates ?(tables = []) ~public_input_size () =
    if SMap.is_empty wires then
      raise @@ Invalid_argument "Make Circuit: empty wires.";
    if SMap.is_empty gates then
      raise @@ Invalid_argument "Make Circuit: empty gates.";
    let circuit_size = List.length (snd (SMap.choose wires)) in
    if Int.equal circuit_size 0 then
      raise (Invalid_argument "Make Circuit: empty circuit.");
    
    let nb_wires = SMap.cardinal wires in
    let () =
      List.iteri
        (fun i (name, l) ->
          verify_name name i;
          if List.compare_length_with l circuit_size = 0 then ()
          else raise (Invalid_argument "Make Circuit: different length wires."))
        (SMap.bindings wires)
    in
    
    let () =
      SMap.iter
        (fun label q ->
          if List.compare_length_with q circuit_size = 0 then ()
          else raise (Invalid_argument "Make Circuit: different length gates.");
          if List.mem label (List.map fst CS.all_selectors) then ()
          else raise (Invalid_argument "Make Circuit: unknown gates."))
        gates
    in
    
    let () =
      List.iter
        (fun l ->
          let sub_table_size = Array.length (List.hd l) in
          if List.length l > nb_wires then
            raise
              (Invalid_argument "Make Circuit: table(s) with too many columns.");
          List.iter
            (fun t ->
              if Array.length t != sub_table_size then
                raise
                  (Invalid_argument
                     "Make Circuit: table(s) with columns of different length.")
              else ())
            l)
        tables
    in
    let table_size =
      if tables = [] then 0
      else List.fold_left (fun acc t -> acc + Array.length (List.hd t)) 0 tables
    in
    
    let ultra = SMap.mem "q_plookup" gates in
    let nb_lookups =
      if not ultra then 0
      else
        let q_plookup = SMap.find "q_plookup" gates in
        List.fold_left
          (fun acc qi -> if Scalar.is_zero qi then acc else acc + 1)
          0 q_plookup
    in
    if ultra && not (SMap.mem "q_table" gates) then
      raise (Invalid_argument "Make Circuit: expected table selector.");
    if ultra && tables = [] then
      raise (Invalid_argument "Make Circuit: tables empty.");
    if (not ultra) && (tables != [] || SMap.mem "q_table" gates) then
      raise (Invalid_argument "Make Circuit: table(s) given with no lookups.");
    let wires = Tables.map Array.of_list wires in
    let gates = Tables.map Array.of_list gates in
    let gates =
      
      if public_input_size > 0 && (not @@ SMap.mem "ql" gates) then
        Tables.add "ql" (Array.init circuit_size (fun _ -> Scalar.zero)) gates
      else gates
    in
    {
      circuit_size;
      wires;
      gates;
      tables;
      public_input_size;
      nb_wires;
      table_size;
      nb_lookups;
      ultra;
    }
  let get_nb_of_constraints cs = Array.length (snd (SMap.choose cs.wires))
  
  let sat_gate identities gate trace tables =
    let open CS in
    let nb_cs = Array.length gate in
    let identities =
      
      List.init nb_cs (fun i ->
          
          let j = (i + 1) mod nb_cs in
          let ci, cj = (gate.(i), gate.(j)) in
          let a, b, c = (trace.(ci.a), trace.(ci.b), trace.(ci.c)) in
          let ag, bg, cg = (trace.(cj.a), trace.(cj.b), trace.(cj.c)) in
          
          List.fold_left
            (fun id_map (s_name, q) ->
              match s_name with
              | x when x = "q_plookup" -> id_map
              | x when x = "q_table" ->
                  
                  let entry : Table.entry = Table.{ a; b; c } in
                  let sub_table = List.nth tables (Scalar.to_z q |> Z.to_int) in
                  let b = Table.mem entry sub_table in
                  let id = [| (if b then Scalar.zero else Scalar.one) |] in
                  SMap.add "q_table" id id_map
              | _ ->
                  
                  let s_id_name, _ = Gates.get_ids s_name in
                  let s_ids = SMap.find s_id_name id_map in
                  
                  List.iteri
                    (fun i s -> s_ids.(i) <- Scalar.(s_ids.(i) + s))
                    ((Gates.get_eqs s_name) ~q ~a ~b ~c ~ag ~bg ~cg ());
                  SMap.add s_id_name s_ids id_map)
            identities ci.sels)
    in
    
    List.for_all
      (SMap.for_all (fun _id_name id ->
           let b = Array.for_all Scalar.is_zero id in
           
           b))
      identities
  let sat cs tables trace =
    
    let identities =
      List.fold_left
        (fun map m ->
          let id, nb_ids = Gates.get_ids m in
          if SMap.mem id map then map
          else SMap.add id (Array.init nb_ids (fun _ -> Scalar.zero)) map)
        (SMap.singleton "q_table" [| Scalar.zero |])
        Gates.gates_list
    in
    let exception Constraint_not_satisfied of string in
    try
      
      List.iteri
        (fun i gate ->
          
          let b = sat_gate identities gate trace tables in
          if b then ()
          else
            
            raise
              (Constraint_not_satisfied
                 (Printf.sprintf "\nGate #%i not satisfied." i)))
        cs;
      true
    with Constraint_not_satisfied _ -> false
  let to_plonk ~public_input_size ?(tables = []) cs =
    let open CS in
    let cs = List.rev Array.(to_list @@ concat cs) in
    assert (cs <> []);
    let add_wires a b c wires =
      let aa = SMap.find "a" wires in
      let bb = SMap.find "b" wires in
      let cc = SMap.find "c" wires in
      let wires = SMap.add "a" (a :: aa) wires in
      let wires = SMap.add "b" (b :: bb) wires in
      let wires = SMap.add "c" (c :: cc) wires in
      wires
    in
    let add_selectors sels map pad =
      
      let map =
        List.fold_left
          (fun map (k, _) ->
            if SMap.mem k map then map
            else
              let zeros = List.init pad (fun _ -> Scalar.zero) in
              SMap.add k zeros map)
          map sels
      in
      
      SMap.fold
        (fun label qq map ->
          let q =
            match List.find_opt (fun (s, _) -> s = label) sels with
            | None -> Scalar.zero
            | Some (_, coeff) -> coeff
          in
          SMap.add label (q :: qq) map)
        map map
    in
    let wires_map = SMap.of_list [ ("a", []); ("b", []); ("c", []) ] in
    let selectors_map = SMap.empty in
    List.fold_left
      (fun (wires_map, selectors_map, pad) { a; b; c; sels; _ } ->
        let wires_map = add_wires a b c wires_map in
        let selectors_map = add_selectors sels selectors_map pad in
        (wires_map, selectors_map, pad + 1))
      (wires_map, selectors_map, 0)
      cs
    |> fun (wires, selectors, _) ->
    let tables = List.map Table.to_list tables in
    make ~wires ~gates:selectors ~public_input_size ~tables ()
end
include Circuit