Commit 1a0e9e92 authored by Raphael Rieu-Helft's avatar Raphael Rieu-Helft

C extraction: use ML types more consistently

parent 5ca3f3f9
...@@ -596,8 +596,6 @@ end ...@@ -596,8 +596,6 @@ end
module mach.fxp.Fxp module mach.fxp.Fxp
syntax type fxp "uint64_t"
syntax val fxp_add "%1 + %2" syntax val fxp_add "%1 + %2"
syntax val fxp_sub "%1 - %2" syntax val fxp_sub "%1 - %2"
syntax val fxp_mul "%1 * %2" syntax val fxp_mul "%1 * %2"
......
...@@ -747,6 +747,7 @@ module MLToC = struct ...@@ -747,6 +747,7 @@ module MLToC = struct
let field i = "__field_"^(string_of_int i) let field i = "__field_"^(string_of_int i)
let structs : struct_def Hid.t = Hid.create 16 let structs : struct_def Hid.t = Hid.create 16
let aliases : C.ty Hid.t = Hid.create 16
let array = create_attribute "ex:array" let array = create_attribute "ex:array"
let array_mk = create_attribute "ex:array_make" let array_mk = create_attribute "ex:array_make"
...@@ -771,6 +772,9 @@ module MLToC = struct ...@@ -771,6 +772,9 @@ module MLToC = struct
if tl = [] if tl = []
then if is_ts_tuple ts then if is_ts_tuple ts
then C.Tvoid then C.Tvoid
else
if Hid.mem aliases ts.ts_name
then Hid.find aliases ts.ts_name
else try Tstruct (Hid.find structs ts.ts_name) else try Tstruct (Hid.find structs ts.ts_name)
with Not_found -> Tnosyntax with Not_found -> Tnosyntax
else C.Tnosyntax else C.Tnosyntax
...@@ -791,8 +795,10 @@ module MLToC = struct ...@@ -791,8 +795,10 @@ module MLToC = struct
| Some s -> C.Tsyntax (s, List.map (ty_of_mlty info) tl) | Some s -> C.Tsyntax (s, List.map (ty_of_mlty info) tl)
| None -> | None ->
if tl = [] if tl = []
then try Tstruct (Hid.find structs id) then if Hid.mem aliases id
with Not_found -> Tnosyntax then Hid.find aliases id
else try Tstruct (Hid.find structs id)
with Not_found -> Tnosyntax
else Tnosyntax else Tnosyntax
end end
| Ttuple [] -> C.Tvoid | Ttuple [] -> C.Tvoid
...@@ -1262,7 +1268,7 @@ module MLToC = struct ...@@ -1262,7 +1268,7 @@ module MLToC = struct
end end
let translate_decl (info:info) (d:decl) ~header : C.definition list = let translate_decl (info:info) (d:decl) ~header : C.definition list =
let translate_fun rs vl e = let translate_fun rs mlty vl e =
Debug.dprintf debug_c_extraction "print %s@." rs.rs_name.id_string; Debug.dprintf debug_c_extraction "print %s@." rs.rs_name.id_string;
if rs_ghost rs if rs_ghost rs
then begin Debug.dprintf debug_c_extraction "is ghost@."; [] end then begin Debug.dprintf debug_c_extraction "is ghost@."; [] end
...@@ -1300,7 +1306,9 @@ module MLToC = struct ...@@ -1300,7 +1306,9 @@ module MLToC = struct
acc && arity_zero ity.ity_node) true ity) acc && arity_zero ity.ity_node) true ity)
in in
(* FIXME is it necessary to have arity 0 in regions ?*) (* FIXME is it necessary to have arity 0 in regions ?*)
let rtype = ty_of_ty info (ty_of_ity rity) in let rtype = try ty_of_mlty info mlty
with Unsupported _ -> (*FIXME*)
ty_of_ty info (ty_of_ity rity) in
let rtype,sdecls = let rtype,sdecls =
if rtype=C.Tnosyntax && is_simple_tuple rity if rtype=C.Tnosyntax && is_simple_tuple rity
then then
...@@ -1328,15 +1336,19 @@ module MLToC = struct ...@@ -1328,15 +1336,19 @@ module MLToC = struct
sdecls@[C.Dfun (rs.rs_name, (rtype,params), (d,s))] in sdecls@[C.Dfun (rs.rs_name, (rtype,params), (d,s))] in
try try
begin match d with begin match d with
| Dlet (Lsym(rs, _, _, vl, e)) -> translate_fun rs vl e | Dlet (Lsym(rs, _, mlty, vl, e)) -> translate_fun rs mlty vl e
| Dtype [{its_name=id; its_def=idef}] -> | Dtype [{its_name=id; its_def=idef}] ->
Debug.dprintf debug_c_extraction "PDtype %s@." id.id_string; Debug.dprintf debug_c_extraction "PDtype %s@." id.id_string;
begin match query_syntax info.syntax id with begin match query_syntax info.syntax id with
| Some _ -> [] | Some _ -> []
| None -> begin | None -> begin
match idef with match idef with
| Some (Dalias _ty) -> [] | Some (Dalias mlty) ->
(*[C.Dtypedef (ty_of_mlty info ty, id)] *) let ty = ty_of_mlty info mlty in
Hid.replace aliases id ty;
[]
(*TODO print actual typedef? *)
(*[C.Dtypedef (ty_of_mlty info ty, id)]*)
| Some (Drecord pjl) -> | Some (Drecord pjl) ->
let pjl = let pjl =
List.filter List.filter
...@@ -1366,7 +1378,7 @@ module MLToC = struct ...@@ -1366,7 +1378,7 @@ module MLToC = struct
end end
| Dlet (Lrec rl) -> | Dlet (Lrec rl) ->
let translate_rdef rd = let translate_rdef rd =
translate_fun rd.rec_sym rd.rec_args rd.rec_exp in translate_fun rd.rec_sym rd.rec_res rd.rec_args rd.rec_exp in
let defs = List.flatten (List.map translate_rdef rl) in let defs = List.flatten (List.map translate_rdef rl) in
if header then defs if header then defs
else else
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment