Revision f4cba4b8 src/printers.ml
src/printers.ml | ||
---|---|---|
323 | 323 |
fprintf_list ~eol:"@, " ~sep:"@, " (fun fmt import -> |
324 | 324 |
fprintf fmt "import %s (%a) returns (%a);" |
325 | 325 |
import.import_nodeid |
326 |
(fprintf_list ~sep:"@ " pp_expr) import.inputs
|
|
327 |
(fprintf_list ~sep:"@ " pp_expr) import.outputs
|
|
326 |
pp_expr import.inputs
|
|
327 |
pp_expr import.outputs
|
|
328 | 328 |
) fmt spec.imports |
329 | 329 |
|
330 |
let pp_spec_as_comment fmt spec = |
|
331 |
fprintf fmt "@[<hov 2>(*@@ "; |
|
332 |
pp_spec fmt spec; |
|
333 |
fprintf fmt "@]*)@ " |
|
330 |
|
|
331 |
let node_as_contract nd = |
|
332 |
match nd.node_spec with |
|
333 |
| None | Some (NodeSpec _) -> raise (Invalid_argument "Not a contract") |
|
334 |
| Some (Contract c) -> ( |
|
335 |
assert (c.locals = []); |
|
336 |
assert (c.stmts = []); |
|
337 |
{ c with |
|
338 |
locals = nd.node_locals; |
|
339 |
stmts = nd.node_stmts; |
|
340 |
} |
|
341 |
) |
|
342 |
|
|
343 |
let pp_contract fmt nd = |
|
344 |
let c = node_as_contract nd in |
|
345 |
let pp_l = fprintf_list ~sep:"," pp_var_name in |
|
346 |
fprintf fmt "@[<hov 2>(*@@ contract %s(%a) returns (%a);@ " |
|
347 |
nd.node_id |
|
348 |
pp_l nd.node_inputs |
|
349 |
pp_l nd.node_outputs; |
|
350 |
fprintf fmt "let@ "; |
|
351 |
pp_spec fmt c; |
|
352 |
fprintf fmt "tel@ @]*)@ " |
|
334 | 353 |
|
354 |
let pp_spec_as_comment fmt (inl, outl, spec) = |
|
355 |
match spec with |
|
356 |
| Contract c -> (* should have been processed by now *) |
|
357 |
fprintf fmt "@[<hov 2>(*@@ "; |
|
358 |
pp_spec fmt c; |
|
359 |
fprintf fmt "@]*)@ " |
|
360 |
|
|
361 |
| NodeSpec name -> (* Pushing stmts in contract. We update the |
|
362 |
original information with the computed one in |
|
363 |
nd. *) |
|
364 |
let pp_l = fprintf_list ~sep:"," pp_var_name in |
|
365 |
fprintf fmt "@[<hov 2>(*@@ contract import %s(%a) returns (%a)@]*)@ " |
|
366 |
name |
|
367 |
pp_l inl |
|
368 |
pp_l outl |
|
369 |
|
|
370 |
|
|
335 | 371 |
let pp_node fmt nd = |
336 | 372 |
fprintf fmt "@[<v 0>"; |
337 | 373 |
(* Prototype *) |
... | ... | |
342 | 378 |
pp_node_args nd.node_outputs; |
343 | 379 |
(* Contracts *) |
344 | 380 |
fprintf fmt "%a%t" |
345 |
(fun fmt s -> match s with Some s -> pp_spec_as_comment fmt s | _ -> ()) nd.node_spec
|
|
381 |
(fun fmt s -> match s with Some s -> pp_spec_as_comment fmt (nd.node_inputs, nd.node_outputs, s) | _ -> ()) nd.node_spec
|
|
346 | 382 |
(fun fmt -> match nd.node_spec with None -> () | Some _ -> fprintf fmt "@ "); |
347 | 383 |
(* Locals *) |
348 | 384 |
fprintf fmt "%a" (fun fmt locals -> |
... | ... | |
375 | 411 |
|
376 | 412 |
(*fprintf fmt "@ /* Scheduling: %a */ @ " (fprintf_list ~sep:", " pp_print_string) (Scheduling.schedule_node nd)*) |
377 | 413 |
|
414 |
let pp_node fmt nd = |
|
415 |
match nd.node_spec, nd.node_iscontract with |
|
416 |
| None, false |
|
417 |
| Some (NodeSpec _), false |
|
418 |
-> pp_node fmt nd |
|
419 |
| Some (Contract _), false -> pp_node fmt nd (* may happen early in the compil process *) |
|
420 |
| Some (Contract _), true -> pp_contract fmt nd |
|
421 |
| _ -> assert false |
|
422 |
|
|
378 | 423 |
let pp_imported_node fmt ind = |
379 | 424 |
fprintf fmt "@[<v 0>"; |
380 | 425 |
(* Prototype *) |
... | ... | |
385 | 430 |
pp_node_args ind.nodei_outputs; |
386 | 431 |
(* Contracts *) |
387 | 432 |
fprintf fmt "%a%t" |
388 |
(fun fmt s -> match s with Some s -> pp_spec_as_comment fmt s | _ -> ()) ind.nodei_spec
|
|
433 |
(fun fmt s -> match s with Some s -> pp_spec_as_comment fmt (ind.nodei_inputs, ind.nodei_outputs, s) | _ -> ()) ind.nodei_spec
|
|
389 | 434 |
(fun fmt -> match ind.nodei_spec with None -> () | Some _ -> fprintf fmt "@ "); |
390 | 435 |
fprintf fmt "@]@ " |
391 | 436 |
|
Also available in: Unified diff