Project

General

Profile

« Previous | Next » 

Revision 525eebd1

Added by Guillaume DAVY about 4 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