Project

General

Profile

Revision f4cba4b8 src/printers.ml

View differences:

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