### Profile

« Previous | Next »

## Revision 525eebd1

#### Added by Guillaume DAVY over 5 years ago

View differences:

93 93
```    in
```
94 94
```    (* Print a when branch of a case *)
```
95 95
```    let pp_when fmt (cond, instrs) =
```
96
```      fprintf fmt "when %s =>@,  @[<v>%a@]"
```
97
```        cond
```
98
```        (Utils.fprintf_list ~sep:";@," pp_instr) instrs
```
96
```      fprintf fmt "when %s =>@,%a" cond (pp_block pp_instr) instrs
```
99 97
```    in
```
100 98
```    (* Print a case *)
```
101
```    let pp_case fmt (g, hl) = fprintf fmt "case %a is@,  @[<v>%a;@]@,end case"
```
102
```      (pp_value machine) g
```
103
```      (Utils.fprintf_list ~sep:";@," pp_when) hl
```
99
```    let pp_case fmt (g, hl) =
```
100
```      fprintf fmt "case %a is@,%aend case"
```
101
```        (pp_value machine) g
```
102
```        (pp_block pp_when) hl
```
103
```    in
```
104
```    (* Print a if *)
```
105
```    (* If neg is true the we must test for the negation of the condition. It
```
106
```       first check that we don't have a negation and a else case, if so it
```
107
```       inverses the two branch and remove the negation doing a recursive
```
108
```       call. *)
```
109
```    let rec pp_if neg fmt (g, instrs1, instrs2) =
```
110
```      match neg, instrs2 with
```
111
```        | true, Some x -> pp_if false fmt (g, x, Some instrs1)
```
112
```        | _ ->
```
113
```          let pp_cond =
```
114
```            if neg then
```
115
```              fun fmt x -> fprintf fmt "! (%a)" (pp_value machine) x
```
116
```            else
```
117
```              pp_value machine
```
118
```          in
```
119
```          let pp_else = match instrs2 with
```
120
```            | None -> fun fmt -> fprintf fmt ""
```
121
```            | Some i2 -> fun fmt ->
```
122
```                fprintf fmt "else@,%a" (pp_block pp_instr) i2
```
123
```          in
```
124
```          fprintf fmt "if %a then@,%a%tend if"
```
125
```            pp_cond g
```
126
```            (pp_block pp_instr) instrs1
```
127
```            pp_else
```
104 128
```    in
```
105 129
```    match get_instr_desc instr with
```
106 130
```      (* no reset *)
```
......
126 150
```            fmt
```
127 151
```            (i, Some (pp_args vl il))
```
128 152
```      | MBranch (_, []) -> assert false
```
153
```      | MBranch (g, (c1, i1)::tl) when c1=tag_false || c1=tag_true ->
```
154
```          let neg = c1=tag_false in
```
155
```          let other = match tl with
```
156
```            | []         -> None
```
157
```            | [(c2, i2)] -> Some i2
```
158
```            | _          -> assert false
```
159
```          in
```
160
```          pp_if neg fmt (g, i1, other)
```
129 161
```      | MBranch (g, hl) -> pp_case fmt (g, hl)
```
130 162
```      | MComment s  ->
```
131 163
```          let lines = String.split_on_char '\n' s in
```
502 502
```  assert (not (String.contains s '\n'));
```
503 503
```  fprintf fmt "-- %s@," s
```
504 504

505
```(* Functions which computes the substitution for polymorphic type *)
```
506 505

506
```(* Functions which computes the substitution for polymorphic type *)
```
507 507

508 508
```(** Check if a submachine is statefull.
```
509 509
```    @param submachine a submachine
```
......
640 640

641 641
```(* Procedure pretty print functions *)
```
642 642

643
```let pp_block pp_item fmt items =
```
644
```  fprintf fmt "  @[<v>%a%t@]@,"
```
645
```    (Utils.fprintf_list ~sep:";@," pp_item) items
```
646
```    (Utils.pp_final_char_if_non_empty ";" items)
```
647

643 648
```(** Print the definition of a procedure
```
644 649
```   @param pp_name the procedure name printer
```
645 650
```   @param pp_prototype the prototype printer
```
......
650 655
```   @param instrs instructions list
```
651 656
```**)
```
652 657
```let pp_procedure_definition pp_name pp_prototype pp_local pp_instr fmt (locals, instrs) =
```
653
```  fprintf fmt "@[<v>%t is%t@[<v>%a%t@]@,begin@,  @[<v>%a%t@]@,end %t@]"
```
658
```  fprintf fmt "@[<v>%t is@,%abegin@,%aend %t@]"
```
654 659
```    pp_prototype
```
655
```    (Utils.pp_final_char_if_non_empty "@,  " locals)
```
656
```    (Utils.fprintf_list ~sep:";@," pp_local) locals
```
657
```    (Utils.pp_final_char_if_non_empty ";" locals)
```
658
```    (Utils.fprintf_list ~sep:";@," pp_instr) instrs
```
659
```    (Utils.pp_final_char_if_non_empty ";" instrs)
```
660
```    (pp_block pp_local) locals
```
661
```    (pp_block pp_instr) instrs
```
660 662
```    pp_name
```
661 663

662 664

Also available in: Unified diff