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