Project

General

Profile

« Previous | Next » 

Revision 525eebd1

Added by Guillaume DAVY over 5 years ago

Ada: Correct branch exporting to handle boolean match(using an ada if)

View differences:

src/backends/Ada/ada_backend_adb.ml
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

Also available in: Unified diff