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
module mach.fxp.Fxp
syntax type fxp "uint64_t"
syntax val fxp_add "%1 + %2"
syntax val fxp_sub "%1 - %2"
syntax val fxp_mul "%1 * %2"
......
......@@ -747,6 +747,7 @@ module MLToC = struct
let field i = "__field_"^(string_of_int i)
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_mk = create_attribute "ex:array_make"
......@@ -771,6 +772,9 @@ module MLToC = struct
if tl = []
then if is_ts_tuple ts
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)
with Not_found -> Tnosyntax
else C.Tnosyntax
......@@ -791,8 +795,10 @@ module MLToC = struct
| Some s -> C.Tsyntax (s, List.map (ty_of_mlty info) tl)
| None ->
if tl = []
then try Tstruct (Hid.find structs id)
with Not_found -> Tnosyntax
then if Hid.mem aliases id
then Hid.find aliases id
else try Tstruct (Hid.find structs id)
with Not_found -> Tnosyntax
else Tnosyntax
end
| Ttuple [] -> C.Tvoid
......@@ -1262,7 +1268,7 @@ module MLToC = struct
end
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;
if rs_ghost rs
then begin Debug.dprintf debug_c_extraction "is ghost@."; [] end
......@@ -1300,7 +1306,9 @@ module MLToC = struct
acc && arity_zero ity.ity_node) true ity)
in
(* 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 =
if rtype=C.Tnosyntax && is_simple_tuple rity
then
......@@ -1328,15 +1336,19 @@ module MLToC = struct
sdecls@[C.Dfun (rs.rs_name, (rtype,params), (d,s))] in
try
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}] ->
Debug.dprintf debug_c_extraction "PDtype %s@." id.id_string;
begin match query_syntax info.syntax id with
| Some _ -> []
| None -> begin
match idef with
| Some (Dalias _ty) -> []
(*[C.Dtypedef (ty_of_mlty info ty, id)] *)
| Some (Dalias mlty) ->
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) ->
let pjl =
List.filter
......@@ -1366,7 +1378,7 @@ module MLToC = struct
end
| Dlet (Lrec rl) ->
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
if header then defs
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