From 623c0ad32146f29707067db2fa9549c6d4515885 Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Sun, 17 Sep 2006 12:52:16 +0000
Subject: Type unrolling in struct and union fields

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@105 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 caml/Cil2Csyntax.ml | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

(limited to 'caml')

diff --git a/caml/Cil2Csyntax.ml b/caml/Cil2Csyntax.ml
index afd5077a..1c796ea3 100644
--- a/caml/Cil2Csyntax.ml
+++ b/caml/Cil2Csyntax.ml
@@ -39,6 +39,32 @@ let stringTable = Hashtbl.create 47
 
 (** ** Functions related to [struct]s and [union]s *)
 
+(* Unroll recursion in struct or union types:
+   substitute [Tcomp_ptr id] by [Tpointer compty] in [ty]. *)
+
+let unrollType id compty ty =
+  let rec unrType ty =
+    match ty with
+    | Tvoid -> ty
+    | Tint(sz, sg) -> ty
+    | Tfloat sz -> ty
+    | Tpointer ty -> Tpointer (unrType ty)
+    | Tarray(ty, sz) -> Tarray (unrType ty, sz)
+    | Tfunction(args, res) -> Tfunction(unrTypelist args, unrType res)
+    | Tstruct(id', fld) ->
+        if id' = id then ty else Tstruct(id', unrFieldlist fld)
+    | Tunion(id', fld) ->
+        if id' = id then ty else Tunion(id', unrFieldlist fld)
+    | Tcomp_ptr id' ->
+        if id' = id then Tpointer compty else ty
+  and unrTypelist = function
+    | Tnil -> Tnil
+    | Tcons(hd, tl) -> Tcons(unrType hd, unrTypelist tl)
+  and unrFieldlist = function
+    | Fnil -> Fnil
+    | Fcons(id, ty, tl) -> Fcons(id, unrType ty, unrFieldlist tl)
+  in unrType ty
+
 (* Return the type of a [struct] field *)
 let rec getFieldType f = function
   | Fnil -> raise Not_found
@@ -345,18 +371,18 @@ and convertLval lv =
     | NoOffset -> e
     | Field (f, ofs) ->
 	begin match t with
-	  | Tstruct(_, fList) ->
+	  | Tstruct(id, fList) ->
 	      begin try
 		let idf = intern_string f.fname in
-		let t' = getFieldType idf fList in
+		let t' = unrollType id t (getFieldType idf fList) in
                   processOffset (Expr (Efield (e, idf), t')) ofs
 	      with Not_found ->
 		internal_error "processOffset: no such struct field"
 	      end
-	  | Tunion(_, fList) ->
+	  | Tunion(id, fList) ->
 	      begin try
 		let idf = intern_string f.fname in
-		let t' = getFieldType idf fList in
+		let t' = unrollType id t (getFieldType idf fList) in
 		  processOffset (Expr (Efield (e, idf), t')) ofs
 	      with Not_found ->
 		internal_error "processOffset: no such union field"
@@ -685,7 +711,6 @@ let convertGFun fdec =
       (intern_string v.vname,
        Internal { fn_return=ret; fn_params=args; fn_vars=varList; fn_body=s })
 
-
 (** Auxiliary for [convertInit] *)
 
 let rec initDataLen accu = function
-- 
cgit