Support C99 compound literals (by expansion in Unblock pass).

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2615 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

16 files changed, 801 insertions, 454 deletions

diff --git a/Changelog b/Changelog
index c497f68..18545bd 100644
--- a/Changelog
+++ b/Changelog
@@ -32,6 +32,8 @@
 - Value analysis and constant propagation: more precise treatment of
   comparisons against an integer constant.
 
+- Language features: support C99 compound literals.
+
 
 Release 2.3pl2, 2014-05-15
 ==========================
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index b8586e0..ffea5a8 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -588,6 +588,8 @@ let rec convertExpr env e =
       Econdition(convertExpr env e1, convertExpr env e2, convertExpr env e3, ty)
   | C.ECast(ty1, e1) ->
       Ecast(convertExpr env e1, convertTyp env ty1)
+  | C.ECompound(ty1, ie) ->
+      unsupported "compound literals"; ezero
 
   | C.ECall({edesc = C.EVar {name = "__builtin_annot"}}, args) ->
       begin match args with
diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml
index 14c9314..99b93c2 100644
--- a/cparser/Bitfields.ml
+++ b/cparser/Bitfields.ml
@@ -315,6 +315,8 @@ let transf_expr env ctx e =
          etyp = e.etyp}
     | ECast(ty, e1) ->
         {edesc = ECast(ty, texp Val e1); etyp = e.etyp}
+    | ECompound _ ->
+        assert false (* does not occur in unblocked code *)
     | ECall(e1, el) ->
         {edesc = ECall(texp Val e1, List.map (texp Val) el); etyp = e.etyp}
 
diff --git a/cparser/C.mli b/cparser/C.mli
index b1e44eb..71ab1d4 100644
--- a/cparser/C.mli
+++ b/cparser/C.mli
@@ -25,7 +25,7 @@ type ident =
   { name: string;                       (* name as in the source *)
     stamp: int }                        (* unique ID *)
 
-(* kinds of integers *)
+(* Kinds of integers *)
 
 type ikind = 
   | IBool       (** [_Bool] *)
@@ -153,6 +153,18 @@ type typ =
   | TUnion of ident * attributes
   | TEnum of ident * attributes
 
+(** Struct or union field *)
+
+type field = {
+    fld_name: string;
+    fld_typ: typ;
+    fld_bitfield: int option
+}
+
+type struct_or_union =
+  | Struct
+  | Union
+
 (** Expressions *)
 
 type exp = { edesc: exp_desc; etyp: typ }
@@ -167,8 +179,17 @@ and exp_desc =
                            (* the type at which the operation is performed *)
   | EConditional of exp * exp * exp
   | ECast of typ * exp
+  | ECompound of typ * init
   | ECall of exp * exp list
 
+(** Initializers *)
+
+and init =
+  | Init_single of exp
+  | Init_array of init list
+  | Init_struct of ident * (field * init) list
+  | Init_union of ident * field * init
+
 (** Statements *)
 
 type stmt = { sdesc: stmt_desc; sloc: location }
@@ -201,30 +222,6 @@ and slabel =
 and decl =
   storage * ident * typ * init option
 
-(** Initializers *)
-
-and init =
-  | Init_single of exp
-  | Init_array of init list
-  | Init_struct of ident * (field * init) list
-  | Init_union of ident * field * init
-
-(** Struct or union field *)
-
-and field = {
-    fld_name: string;
-    fld_typ: typ;
-    fld_bitfield: int option
-}
-
-type struct_or_union =
-  | Struct
-  | Union
-
-(** Enumerator *)
-
-type enumerator = ident * int64 * exp option
-
 (** Function definitions *)
 
 type fundef = {
@@ -239,6 +236,10 @@ type fundef = {
     fd_body: stmt
 }
 
+(** Element of an enumeration *)
+
+type enumerator = ident * int64 * exp option
+
 (** Global declarations *)
 
 type globdecl =
diff --git a/cparser/Ceval.ml b/cparser/Ceval.ml
index 6fb0d37..39cda58 100644
--- a/cparser/Ceval.ml
+++ b/cparser/Ceval.ml
@@ -258,6 +258,8 @@ let rec expr env e =
   (* | ECast(TInt (_, _), EConst (CFloat (_, _))) -> TODO *)
   | ECast(ty, e1) ->
       cast env ty e1.etyp (expr env e1)
+  | ECompound _ ->
+      raise Notconst
   | ECall _ ->
       raise Notconst
 
diff --git a/cparser/Cleanup.ml b/cparser/Cleanup.ml
index 09595a1..09eaff9 100644
--- a/cparser/Cleanup.ml
+++ b/cparser/Cleanup.ml
@@ -65,9 +65,10 @@ let rec add_exp e =
   | EBinop(op, e1, e2, ty) -> add_exp e1; add_exp e2
   | EConditional(e1, e2, e3) -> add_exp e1; add_exp e2; add_exp e3
   | ECast(ty, e1) -> add_typ ty; add_exp e1
+  | ECompound(ty, ie) -> add_typ ty; add_init ie
   | ECall(e1, el) -> add_exp e1; List.iter add_exp el
 
-let rec add_init = function
+and add_init = function
   | Init_single e -> add_exp e
   | Init_array il -> List.iter add_init il
   | Init_struct(id, il) -> addref id; List.iter (fun (_, i) -> add_init i) il
diff --git a/cparser/Cprint.ml b/cparser/Cprint.ml
index f26025e..ee8002d 100644
--- a/cparser/Cprint.ml
+++ b/cparser/Cprint.ml
@@ -191,7 +191,7 @@ let precedence = function               (* H&S section 7.2 *)
   | EUnop((Odot _|Oarrow _), _) -> (16, LtoR)
   | EUnop((Opostincr|Opostdecr), _) -> (16, LtoR)
   | EUnop((Opreincr|Opredecr|Onot|Olognot|Ominus|Oplus|Oaddrof|Oderef), _) -> (15, RtoL)
-  | ECast _ -> (14, RtoL)
+  | ECast _ | ECompound _ -> (14, RtoL)
   | EBinop((Omul|Odiv|Omod), _, _, _) -> (13, LtoR)
   | EBinop((Oadd|Osub), _, _, _) -> (12, LtoR)
   | EBinop((Oshl|Oshr), _, _, _) -> (11, LtoR)
@@ -310,6 +310,8 @@ let rec exp pp (prec, a) =
       fprintf pp "%a@ ? %a@ : %a" exp (4, a1) exp (4, a2) exp (4, a3)
   | ECast(ty, a1) ->
       fprintf pp "(%a) %a" typ ty exp (prec', a1)
+  | ECompound(ty, i) ->
+      fprintf pp "(%a) %a" typ ty init i
   | ECall({edesc = EVar {name = "__builtin_va_start"}},
           [a1; {edesc = EUnop(Oaddrof, a2)}]) ->
       fprintf pp "__builtin_va_start@[<hov 1>(%a,@ %a)@]"
@@ -330,7 +332,7 @@ let rec exp pp (prec, a) =
   end;
   if prec' < prec then fprintf pp ")@]" else fprintf pp "@]"
 
-let rec init pp = function
+and init pp = function
   | Init_single e ->
       exp pp (2, e)
   | Init_array il ->
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 1169346..9ad0b13 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -714,6 +714,7 @@ let rec is_lvalue e =
   | EUnop((Oderef | Oarrow _), _) -> true
   | EUnop(Odot _, e') -> is_lvalue e'
   | EBinop(Oindex, _, _, _) -> true
+  | ECompound _ -> true
   | _ -> false
 
 (* Check that a C expression is a modifiable l-value: an l-value
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index a352e5f..c4057e6 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -789,6 +789,389 @@ let elab_type loc env spec decl =
   ty
 
 
+(* Elaboration of initializers. C99 section 6.7.8 *)
+
+let init_char_array_string opt_size s =
+  let len = Int64.of_int (String.length s) in
+  let size =
+    match opt_size with
+    | Some sz -> sz
+    | None -> Int64.succ len  (* include final 0 character *) in
+  let rec add_chars i init =
+    if i < 0L then init else begin
+      let c =
+        if i < len then Int64.of_int (Char.code s.[Int64.to_int i]) else 0L in
+      add_chars (Int64.pred i) (Init_single (intconst c IInt) :: init)
+    end in
+  Init_array (add_chars (Int64.pred size) [])
+
+let init_int_array_wstring opt_size s =
+  let len = Int64.of_int (List.length s) in
+  let size =
+    match opt_size with
+    | Some sz -> sz
+    | None -> Int64.succ len  (* include final 0 character *) in
+  let rec add_chars i s init =
+    if i < 0L then init else begin
+      let (c, s') =
+        match s with [] -> (0L, []) | c::s' -> (c, s') in
+      add_chars (Int64.pred i) s' (Init_single (intconst c IInt) :: init)
+    end in
+  Init_array (add_chars (Int64.pred size) (List.rev s) [])
+
+let check_init_type loc env a ty =
+  if valid_assignment env a ty then ()
+  else if valid_cast env a.etyp ty then
+    warning loc
+      "initializer has type@ %a@ instead of the expected type @ %a"
+      Cprint.typ a.etyp Cprint.typ ty
+  else
+    error loc
+      "initializer has type@ %a@ instead of the expected type @ %a"
+      Cprint.typ a.etyp Cprint.typ ty
+
+(* Representing initialization state using zippers *)
+
+module I = struct
+
+  type zipinit =
+    | Ztop of string * typ
+
+    | Zarray of zipinit                 (* ancestor *)
+              * typ                     (* type of elements *)
+              * int64 option            (* size *)
+              * init                    (* default initializer *)
+              * init list               (* elements before point, reversed *)
+              * int64                   (* position of point *)
+              * init list               (* elements after point *)
+
+    | Zstruct of zipinit                (* ancestor *)
+               * ident                  (* struct type *)
+               * (field * init) list    (* elements before current, reversed *)
+               * field                  (* current field *)
+               * (field * init) list    (* elements after current *)
+
+    | Zunion of zipinit                 (* ancestor *)
+              * ident                   (* union type *)
+              * field                   (* current member *)
+
+  type state = zipinit * init        (* current point & init for this point *)
+
+  (* The initial state: default initialization, current point at top *)
+  let top env name ty = (Ztop(name, ty), default_init env ty)
+
+  (* Change the initializer for the current point *)
+  let set (z, i) i' = (z, i')
+
+  (* Put the current point back to the top *)
+  let rec to_top = function
+    | Ztop(name, ty), i as zi -> zi
+    | Zarray(z, ty, sz, dfl, before, idx, after), i ->
+        to_top (z, Init_array (List.rev_append before (i :: after)))
+    | Zstruct(z, id, before, fld, after), i ->
+        to_top (z, Init_struct(id, List.rev_append before ((fld, i) :: after)))
+    | Zunion(z, id, fld), i ->
+        to_top (z, Init_union(id, fld, i))
+
+  (* Extract the initializer corresponding to the current state *)
+  let to_init zi = snd (to_top zi)
+
+  (* The type of the current point *)
+  let typeof = function
+    | Ztop(name, ty), i -> ty
+    | Zarray(z, ty, sz, dfl, before, idx, after), i -> ty
+    | Zstruct(z, id, before, fld, after), i -> fld.fld_typ
+    | Zunion(z, id, fld), i -> fld.fld_typ
+
+  (* The name of the path leading to the current point, for error reporting *)
+  let rec zipname = function
+    | Ztop(name, ty) -> name
+    | Zarray(z, ty, sz, dfl, before, idx, after) ->
+        sprintf "%s[%Ld]" (zipname z) idx
+    | Zstruct(z, id, before, fld, after) ->
+        sprintf "%s.%s" (zipname z) fld.fld_name
+    | Zunion(z, id, fld) ->
+        sprintf "%s.%s" (zipname z) fld.fld_name
+
+  let name (z, i) = zipname z
+
+  (* Auxiliary functions to deal with arrays *)
+  let index_below (idx: int64) (sz: int64 option) =
+    match sz with None -> true | Some sz -> idx < sz
+
+  let il_head dfl = function [] -> dfl | i1 :: il -> i1
+  let il_tail = function [] -> [] | i1 :: il -> il
+
+  (* Advance the current point to the next point in right-up order.
+     Return None if no next point, i.e. we are at top *)
+  let rec next = function
+    | Ztop(name, ty), i -> None
+    | Zarray(z, ty, sz, dfl, before, idx, after), i ->
+        let idx' = Int64.succ idx in
+        if index_below idx' sz
+        then Some(Zarray(z, ty, sz, dfl, i :: before, idx', il_tail after),
+                  il_head dfl after)
+        else next (z, Init_array (List.rev_append before (i :: after)))
+    | Zstruct(z, id, before, fld, []), i ->
+        next (z, Init_struct(id, List.rev_append before [(fld, i)]))
+    | Zstruct(z, id, before, fld, (fld1, i1) :: after), i ->
+        Some(Zstruct(z, id, (fld, i) :: before, fld1, after), i1)
+    | Zunion(z, id, fld), i ->
+        next (z, Init_union(id, fld, i))
+
+  (* Move the current point "down" to the first component of an array,
+     struct, or union.  No effect if the current point is a scalar. *)
+  let rec first env (z, i as zi) =
+    let ty = typeof zi in
+    match unroll env ty, i with
+    | TArray(ty, sz, _), Init_array il ->
+        if index_below 0L sz then begin
+          let dfl = default_init env ty in
+          Some(Zarray(z, ty, sz, dfl, [], 0L, il_tail il), il_head dfl il)
+        end
+        else None
+    | TStruct(id, _), Init_struct(id', []) ->
+        None
+    | TStruct(id, _), Init_struct(id', (fld1, i1) :: flds) ->
+        Some(Zstruct(z, id, [], fld1, flds), i1)
+    | TUnion(id, _), Init_union(id', fld, i) ->
+        begin match (Env.find_union env id).ci_members with
+        | [] -> None
+        | fld1 :: _ ->
+            Some(Zunion(z, id, fld1),
+                 if fld.fld_name = fld1.fld_name
+                 then i
+                 else default_init env fld1.fld_typ)
+        end 
+    | (TStruct _ | TUnion _), Init_single a ->
+        (* This is a previous whole-struct initialization that we
+           are going to overwrite.  Revert to the default initializer. *)
+        first env (z, default_init env ty)
+    | _ ->
+        Some (z, i)
+
+  (* Move to the [n]-th element of the current point, which must be
+     an array. *)
+  let index env (z, i as zi) n =
+    match unroll env (typeof zi), i with
+    | TArray(ty, sz, _), Init_array il ->
+        if n >= 0L && index_below n sz then begin 
+          let dfl = default_init env ty in
+          let rec loop p before after =
+            if p = n then
+              Some(Zarray(z, ty, sz, dfl, before, n, il_tail after),
+                   il_head dfl after)
+            else
+              loop (Int64.succ p)
+                   (il_head dfl after :: before)
+                   (il_tail after)
+          in loop 0L [] il
+        end else
+          None
+    | _, _ ->
+        None
+
+  (* Move to the member named [name] of the current point, which must be
+     a struct or a union. *)
+  let rec member env (z, i as zi) name =
+    let ty = typeof zi in
+    match unroll env ty, i with
+    | TStruct(id, _), Init_struct(id', flds) ->
+        let rec find before = function
+          | [] -> None
+          | (fld, i as f_i) :: after ->
+              if fld.fld_name = name then
+                Some(Zstruct(z, id, before, fld, after), i)
+              else
+                find (f_i :: before) after
+        in find [] flds
+    | TUnion(id, _), Init_union(id', fld, i) ->
+        if fld.fld_name = name then
+          Some(Zunion(z, id, fld), i)
+        else begin
+          let rec find = function
+            | [] -> None
+            | fld1 :: rem ->
+                if fld1.fld_name = name then
+                  Some(Zunion(z, id, fld1), default_init env fld1.fld_typ)
+                else
+                  find rem
+           in find (Env.find_union env id).ci_members
+         end
+    | (TStruct _ | TUnion _), Init_single a ->
+        member env (z, default_init env ty) name
+    | _, _ ->
+        None
+end
+
+(* Interpret the given designator, moving the initialization state [zi]
+   "down" accordingly. *)
+
+let rec elab_designator loc env zi desig =
+  match desig with
+  | [] -> 
+      zi
+  | INFIELD_INIT name :: desig' ->
+      begin match I.member env zi name with
+      | Some zi' ->
+          elab_designator loc env zi' desig'
+      | None ->
+          error loc "%s has no member named %s" (I.name zi) name;
+          raise Exit
+      end
+  | ATINDEX_INIT a :: desig' ->
+      begin match Ceval.integer_expr env (!elab_expr_f loc env a) with
+      | None ->
+          error loc "array element designator for %s is not a compile-time constant"
+                    (I.name zi);
+          raise Exit
+      | Some n ->
+          match I.index env zi n with
+          | Some zi' ->
+              elab_designator loc env zi' desig'
+          | None ->
+              error loc "bad array element designator %Ld within %s"
+                      n (I.name zi);
+            raise Exit
+      end
+
+(* Elaboration of an initialization expression.  Return the corresponding
+   initializer. *)
+
+let elab_init loc env root ty_root ie =
+
+(* Perform the initializations described by the list [il] over
+   the initialization state [zi].  [first] is true if we are at the
+   beginning of a braced initializer.  Returns the final initializer. *)
+
+let rec elab_list zi il first =
+  match il with
+  | [] ->
+      (* All initialization items consumed. *)
+      I.to_init zi
+  | (desig, item) :: il' ->
+      if desig = [] then begin
+        match (if first then I.first env zi else I.next zi)
+        with
+        | None ->
+            warning loc "excess elements at end of initializer for %s, ignored"
+                        (I.name zi);
+            I.to_init zi
+        | Some zi' ->
+            elab_item zi' item il'
+      end else
+        elab_item (elab_designator loc env (I.to_top zi) desig) item il'
+
+(* Perform the initialization described by [item] for the current
+   subobject of state [zi].  Continue initializing with the list [il]. *)
+
+and elab_item zi item il =
+  let ty = I.typeof zi in
+  match item, unroll env ty with
+  (* Special case char array = "string literal" 
+               or wchar array = L"wide string literal" *)
+  | (SINGLE_INIT (CONSTANT (CONST_STRING(w, s)))
+     | COMPOUND_INIT [_, SINGLE_INIT(CONSTANT (CONST_STRING(w, s)))]),
+    TArray(ty_elt, sz, _)
+    when is_integer_type env ty_elt ->
+      begin match elab_string_literal loc w s, unroll env ty_elt with
+      | CStr s, TInt((IChar | ISChar | IUChar), _) ->
+          if not (I.index_below (Int64.of_int(String.length s - 1)) sz) then
+            warning loc "initializer string for array of chars %s is too long"
+                        (I.name zi);
+          elab_list (I.set zi (init_char_array_string sz s)) il false
+      | CStr _, _ ->
+          error loc "initialization of an array of non-char elements with a string literal";
+          elab_list zi il false
+      | CWStr s, TInt(ik, _) when ik = wchar_ikind ->
+          if not (I.index_below (Int64.of_int(List.length s - 1)) sz) then
+            warning loc "initializer string for array of wide chars %s is too long"
+                        (I.name zi);
+          elab_list (I.set zi (init_int_array_wstring sz s)) il false
+      | CWStr _, _ ->
+          error loc "initialization of an array of non-wchar_t elements with a wide string literal";
+          elab_list zi il false
+      | _ -> assert false
+      end
+  (* Brace-enclosed compound initializer *)
+  | COMPOUND_INIT il', _ ->
+      (* Process the brace-enclosed stuff, obtaining its initializer *)
+      let ini' = elab_list (I.top env (I.name zi) ty) il' true in
+      (* Initialize current subobject with this state, and continue *)
+      elab_list (I.set zi ini') il false
+  (* Single expression *)
+  | SINGLE_INIT a, _ ->
+      let a' = !elab_expr_f loc env a in
+      elab_single zi a' il
+  (* No initializer: can this happen? *)
+  | NO_INIT, _ ->
+      elab_list zi il false
+
+(* Perform initialization by a single expression [a] for the current
+   subobject of state [zi],  Continue initializing with the list [il']. *)
+
+and elab_single zi a il =
+  let ty = I.typeof zi in
+  match unroll env ty with
+  | TInt _ | TEnum _ | TFloat _ | TPtr _ ->
+      (* This is a scalar: do direct initialization and continue *)
+      check_init_type loc env a ty;
+      elab_list (I.set zi (Init_single a)) il false
+  | TStruct _ | TUnion _ when compatible_types ~noattrs:true env ty a.etyp ->
+      (* This is a composite that can be initialized directly
+         from the expression: do as above *)
+      elab_list (I.set zi (Init_single a)) il false
+  | TStruct _ | TUnion _ | TArray _ ->
+      (* This is an aggregate: we need to drill into it, recursively *)
+      begin match I.first env zi with
+      | Some zi' ->
+          elab_single zi' a il
+      | None ->
+          error loc "initializer for aggregate %s with no elements requires explicit braces"
+                    (I.name zi);
+          raise Exit
+      end
+  | _ ->
+      error loc "impossible to initialize %s of type@ %a"
+                (I.name zi) Cprint.typ ty;
+      raise Exit
+
+(* Start with top-level object initialized to default *)
+
+in elab_item (I.top env root ty_root) ie []
+
+(* Elaboration of a top-level initializer *)
+
+let elab_initial loc env root ty ie =
+  match ie with
+  | NO_INIT -> None
+  | _ ->
+    try
+      Some (elab_init loc env root ty ie)
+    with
+    | Exit -> None  (* error was already reported *)
+    | Env.Error msg -> error loc "%s" (Env.error_message msg); None
+
+(* Complete an array type with the size obtained from the initializer:
+   "int x[] = { 1, 2, 3 }" becomes "int x[3] = ..." *)
+
+let fixup_typ loc env ty init =
+  match unroll env ty, init with
+  | TArray(ty_elt, None, attr), Init_array il ->
+      if il = [] then warning loc "array of size 0";
+      TArray(ty_elt, Some(Int64.of_int(List.length il)), attr)
+  | _ -> ty
+
+(* Entry point *)
+
+let elab_initializer loc env root ty ie =
+  match elab_initial loc env root ty ie with
+  | None ->
+      (ty, None)
+  | Some init ->
+      (fixup_typ loc env ty init, Some init)
+
+
 (* Elaboration of expressions *)
 
 let elab_expr loc env a =
@@ -923,7 +1306,7 @@ let elab_expr loc env a =
   | UNARY(POSDECR, a1) ->
       elab_pre_post_incr_decr Opostdecr "postfix '--'" a1
 
-(* 6.5.3 Unary expressions *)
+(* 6.5.4 Cast operators *)
 
   | CAST ((spec, dcl), SINGLE_INIT a1) ->
       let ty = elab_type loc env spec dcl in
@@ -932,11 +1315,16 @@ let elab_expr loc env a =
         err "illegal cast from %a@ to %a" Cprint.typ b1.etyp Cprint.typ ty;
       { edesc = ECast(ty, b1); etyp = ty }
 
-  | CAST ((spec, dcl), _) ->
-      err "compound literals are not supported";
-      (* continue with dummy expression of the correct type *)
+(* 6.5.2.5 Compound literals *)
+
+  | CAST ((spec, dcl), ie) ->
       let ty = elab_type loc env spec dcl in
-      { edesc = ECast(ty, nullconst); etyp = ty }
+      begin match elab_initializer loc env "<compound literal>" ty ie with
+      | (ty', Some i) -> { edesc = ECompound(ty', i); etyp = ty' }
+      | (ty', None)   -> error "ill-formed compound literal"
+      end
+
+(* 6.5.3 Unary expressions *)
 
   | EXPR_SIZEOF a1 ->
       let b1 = elab a1 in
@@ -1328,389 +1716,6 @@ let elab_for_expr loc env = function
   | None -> { sdesc = Sskip; sloc = elab_loc loc }
   | Some a -> { sdesc = Sdo (elab_expr loc env a); sloc = elab_loc loc }
 
-
-(* Elaboration of initializers. C99 section 6.7.8 *)
-
-let init_char_array_string opt_size s =
-  let len = Int64.of_int (String.length s) in
-  let size =
-    match opt_size with
-    | Some sz -> sz
-    | None -> Int64.succ len  (* include final 0 character *) in
-  let rec add_chars i init =
-    if i < 0L then init else begin
-      let c =
-        if i < len then Int64.of_int (Char.code s.[Int64.to_int i]) else 0L in
-      add_chars (Int64.pred i) (Init_single (intconst c IInt) :: init)
-    end in
-  Init_array (add_chars (Int64.pred size) [])
-
-let init_int_array_wstring opt_size s =
-  let len = Int64.of_int (List.length s) in
-  let size =
-    match opt_size with
-    | Some sz -> sz
-    | None -> Int64.succ len  (* include final 0 character *) in
-  let rec add_chars i s init =
-    if i < 0L then init else begin
-      let (c, s') =
-        match s with [] -> (0L, []) | c::s' -> (c, s') in
-      add_chars (Int64.pred i) s' (Init_single (intconst c IInt) :: init)
-    end in
-  Init_array (add_chars (Int64.pred size) (List.rev s) [])
-
-let check_init_type loc env a ty =
-  if valid_assignment env a ty then ()
-  else if valid_cast env a.etyp ty then
-    warning loc
-      "initializer has type@ %a@ instead of the expected type @ %a"
-      Cprint.typ a.etyp Cprint.typ ty
-  else
-    error loc
-      "initializer has type@ %a@ instead of the expected type @ %a"
-      Cprint.typ a.etyp Cprint.typ ty
-
-(* Representing initialization state using zippers *)
-
-module I = struct
-
-  type zipinit =
-    | Ztop of string * typ
-
-    | Zarray of zipinit                 (* ancestor *)
-              * typ                     (* type of elements *)
-              * int64 option            (* size *)
-              * init                    (* default initializer *)
-              * init list               (* elements before point, reversed *)
-              * int64                   (* position of point *)
-              * init list               (* elements after point *)
-
-    | Zstruct of zipinit                (* ancestor *)
-               * ident                  (* struct type *)
-               * (field * init) list    (* elements before current, reversed *)
-               * field                  (* current field *)
-               * (field * init) list    (* elements after current *)
-
-    | Zunion of zipinit                 (* ancestor *)
-              * ident                   (* union type *)
-              * field                   (* current member *)
-
-  type state = zipinit * init        (* current point & init for this point *)
-
-  (* The initial state: default initialization, current point at top *)
-  let top env name ty = (Ztop(name, ty), default_init env ty)
-
-  (* Change the initializer for the current point *)
-  let set (z, i) i' = (z, i')
-
-  (* Put the current point back to the top *)
-  let rec to_top = function
-    | Ztop(name, ty), i as zi -> zi
-    | Zarray(z, ty, sz, dfl, before, idx, after), i ->
-        to_top (z, Init_array (List.rev_append before (i :: after)))
-    | Zstruct(z, id, before, fld, after), i ->
-        to_top (z, Init_struct(id, List.rev_append before ((fld, i) :: after)))
-    | Zunion(z, id, fld), i ->
-        to_top (z, Init_union(id, fld, i))
-
-  (* Extract the initializer corresponding to the current state *)
-  let to_init zi = snd (to_top zi)
-
-  (* The type of the current point *)
-  let typeof = function
-    | Ztop(name, ty), i -> ty
-    | Zarray(z, ty, sz, dfl, before, idx, after), i -> ty
-    | Zstruct(z, id, before, fld, after), i -> fld.fld_typ
-    | Zunion(z, id, fld), i -> fld.fld_typ
-
-  (* The name of the path leading to the current point, for error reporting *)
-  let rec zipname = function
-    | Ztop(name, ty) -> name
-    | Zarray(z, ty, sz, dfl, before, idx, after) ->
-        sprintf "%s[%Ld]" (zipname z) idx
-    | Zstruct(z, id, before, fld, after) ->
-        sprintf "%s.%s" (zipname z) fld.fld_name
-    | Zunion(z, id, fld) ->
-        sprintf "%s.%s" (zipname z) fld.fld_name
-
-  let name (z, i) = zipname z
-
-  (* Auxiliary functions to deal with arrays *)
-  let index_below (idx: int64) (sz: int64 option) =
-    match sz with None -> true | Some sz -> idx < sz
-
-  let il_head dfl = function [] -> dfl | i1 :: il -> i1
-  let il_tail = function [] -> [] | i1 :: il -> il
-
-  (* Advance the current point to the next point in right-up order.
-     Return None if no next point, i.e. we are at top *)
-  let rec next = function
-    | Ztop(name, ty), i -> None
-    | Zarray(z, ty, sz, dfl, before, idx, after), i ->
-        let idx' = Int64.succ idx in
-        if index_below idx' sz
-        then Some(Zarray(z, ty, sz, dfl, i :: before, idx', il_tail after),
-                  il_head dfl after)
-        else next (z, Init_array (List.rev_append before (i :: after)))
-    | Zstruct(z, id, before, fld, []), i ->
-        next (z, Init_struct(id, List.rev_append before [(fld, i)]))
-    | Zstruct(z, id, before, fld, (fld1, i1) :: after), i ->
-        Some(Zstruct(z, id, (fld, i) :: before, fld1, after), i1)
-    | Zunion(z, id, fld), i ->
-        next (z, Init_union(id, fld, i))
-
-  (* Move the current point "down" to the first component of an array,
-     struct, or union.  No effect if the current point is a scalar. *)
-  let rec first env (z, i as zi) =
-    let ty = typeof zi in
-    match unroll env ty, i with
-    | TArray(ty, sz, _), Init_array il ->
-        if index_below 0L sz then begin
-          let dfl = default_init env ty in
-          Some(Zarray(z, ty, sz, dfl, [], 0L, il_tail il), il_head dfl il)
-        end
-        else None
-    | TStruct(id, _), Init_struct(id', []) ->
-        None
-    | TStruct(id, _), Init_struct(id', (fld1, i1) :: flds) ->
-        Some(Zstruct(z, id, [], fld1, flds), i1)
-    | TUnion(id, _), Init_union(id', fld, i) ->
-        begin match (Env.find_union env id).ci_members with
-        | [] -> None
-        | fld1 :: _ ->
-            Some(Zunion(z, id, fld1),
-                 if fld.fld_name = fld1.fld_name
-                 then i
-                 else default_init env fld1.fld_typ)
-        end 
-    | (TStruct _ | TUnion _), Init_single a ->
-        (* This is a previous whole-struct initialization that we
-           are going to overwrite.  Revert to the default initializer. *)
-        first env (z, default_init env ty)
-    | _ ->
-        Some (z, i)
-
-  (* Move to the [n]-th element of the current point, which must be
-     an array. *)
-  let index env (z, i as zi) n =
-    match unroll env (typeof zi), i with
-    | TArray(ty, sz, _), Init_array il ->
-        if n >= 0L && index_below n sz then begin 
-          let dfl = default_init env ty in
-          let rec loop p before after =
-            if p = n then
-              Some(Zarray(z, ty, sz, dfl, before, n, il_tail after),
-                   il_head dfl after)
-            else
-              loop (Int64.succ p)
-                   (il_head dfl after :: before)
-                   (il_tail after)
-          in loop 0L [] il
-        end else
-          None
-    | _, _ ->
-        None
-
-  (* Move to the member named [name] of the current point, which must be
-     a struct or a union. *)
-  let rec member env (z, i as zi) name =
-    let ty = typeof zi in
-    match unroll env ty, i with
-    | TStruct(id, _), Init_struct(id', flds) ->
-        let rec find before = function
-          | [] -> None
-          | (fld, i as f_i) :: after ->
-              if fld.fld_name = name then
-                Some(Zstruct(z, id, before, fld, after), i)
-              else
-                find (f_i :: before) after
-        in find [] flds
-    | TUnion(id, _), Init_union(id', fld, i) ->
-        if fld.fld_name = name then
-          Some(Zunion(z, id, fld), i)
-        else begin
-          let rec find = function
-            | [] -> None
-            | fld1 :: rem ->
-                if fld1.fld_name = name then
-                  Some(Zunion(z, id, fld1), default_init env fld1.fld_typ)
-                else
-                  find rem
-           in find (Env.find_union env id).ci_members
-         end
-    | (TStruct _ | TUnion _), Init_single a ->
-        member env (z, default_init env ty) name
-    | _, _ ->
-        None
-end
-
-(* Interpret the given designator, moving the initialization state [zi]
-   "down" accordingly. *)
-
-let rec elab_designator loc env zi desig =
-  match desig with
-  | [] -> 
-      zi
-  | INFIELD_INIT name :: desig' ->
-      begin match I.member env zi name with
-      | Some zi' ->
-          elab_designator loc env zi' desig'
-      | None ->
-          error loc "%s has no member named %s" (I.name zi) name;
-          raise Exit
-      end
-  | ATINDEX_INIT a :: desig' ->
-      begin match Ceval.integer_expr env (elab_expr loc env a) with
-      | None ->
-          error loc "array element designator for %s is not a compile-time constant"
-                    (I.name zi);
-          raise Exit
-      | Some n ->
-          match I.index env zi n with
-          | Some zi' ->
-              elab_designator loc env zi' desig'
-          | None ->
-              error loc "bad array element designator %Ld within %s"
-                      n (I.name zi);
-            raise Exit
-      end
-
-(* Elaboration of an initialization expression.  Return the corresponding
-   initializer. *)
-
-let elab_init loc env root ty_root ie =
-
-(* Perform the initializations described by the list [il] over
-   the initialization state [zi].  [first] is true if we are at the
-   beginning of a braced initializer.  Returns the final initializer. *)
-
-let rec elab_list zi il first =
-  match il with
-  | [] ->
-      (* All initialization items consumed. *)
-      I.to_init zi
-  | (desig, item) :: il' ->
-      if desig = [] then begin
-        match (if first then I.first env zi else I.next zi)
-        with
-        | None ->
-            warning loc "excess elements at end of initializer for %s, ignored"
-                        (I.name zi);
-            I.to_init zi
-        | Some zi' ->
-            elab_item zi' item il'
-      end else
-        elab_item (elab_designator loc env (I.to_top zi) desig) item il'
-
-(* Perform the initialization described by [item] for the current
-   subobject of state [zi].  Continue initializing with the list [il]. *)
-
-and elab_item zi item il =
-  let ty = I.typeof zi in
-  match item, unroll env ty with
-  (* Special case char array = "string literal" 
-               or wchar array = L"wide string literal" *)
-  | (SINGLE_INIT (CONSTANT (CONST_STRING(w, s)))
-     | COMPOUND_INIT [_, SINGLE_INIT(CONSTANT (CONST_STRING(w, s)))]),
-    TArray(ty_elt, sz, _)
-    when is_integer_type env ty_elt ->
-      begin match elab_string_literal loc w s, unroll env ty_elt with
-      | CStr s, TInt((IChar | ISChar | IUChar), _) ->
-          if not (I.index_below (Int64.of_int(String.length s - 1)) sz) then
-            warning loc "initializer string for array of chars %s is too long"
-                        (I.name zi);
-          elab_list (I.set zi (init_char_array_string sz s)) il false
-      | CStr _, _ ->
-          error loc "initialization of an array of non-char elements with a string literal";
-          elab_list zi il false
-      | CWStr s, TInt(ik, _) when ik = wchar_ikind ->
-          if not (I.index_below (Int64.of_int(List.length s - 1)) sz) then
-            warning loc "initializer string for array of wide chars %s is too long"
-                        (I.name zi);
-          elab_list (I.set zi (init_int_array_wstring sz s)) il false
-      | CWStr _, _ ->
-          error loc "initialization of an array of non-wchar_t elements with a wide string literal";
-          elab_list zi il false
-      | _ -> assert false
-      end
-  (* Brace-enclosed compound initializer *)
-  | COMPOUND_INIT il', _ ->
-      (* Process the brace-enclosed stuff, obtaining its initializer *)
-      let ini' = elab_list (I.top env (I.name zi) ty) il' true in
-      (* Initialize current subobject with this state, and continue *)
-      elab_list (I.set zi ini') il false
-  (* Single expression *)
-  | SINGLE_INIT a, _ ->
-      let a' = elab_expr loc env a in
-      elab_single zi a' il
-  (* No initializer: can this happen? *)
-  | NO_INIT, _ ->
-      elab_list zi il false
-
-(* Perform initialization by a single expression [a] for the current
-   subobject of state [zi],  Continue initializing with the list [il']. *)
-
-and elab_single zi a il =
-  let ty = I.typeof zi in
-  match unroll env ty with
-  | TInt _ | TEnum _ | TFloat _ | TPtr _ ->
-      (* This is a scalar: do direct initialization and continue *)
-      check_init_type loc env a ty;
-      elab_list (I.set zi (Init_single a)) il false
-  | TStruct _ | TUnion _ when compatible_types ~noattrs:true env ty a.etyp ->
-      (* This is a composite that can be initialized directly
-         from the expression: do as above *)
-      elab_list (I.set zi (Init_single a)) il false
-  | TStruct _ | TUnion _ | TArray _ ->
-      (* This is an aggregate: we need to drill into it, recursively *)
-      begin match I.first env zi with
-      | Some zi' ->
-          elab_single zi' a il
-      | None ->
-          error loc "initializer for aggregate %s with no elements requires explicit braces"
-                    (I.name zi);
-          raise Exit
-      end
-  | _ ->
-      error loc "impossible to initialize %s of type@ %a"
-                (I.name zi) Cprint.typ ty;
-      raise Exit
-
-(* Start with top-level object initialized to default *)
-
-in elab_item (I.top env root ty_root) ie []
-
-(* Elaboration of a top-level initializer *)
-
-let elab_initial loc env root ty ie =
-  match ie with
-  | NO_INIT -> None
-  | _ ->
-    try
-      Some (elab_init loc env root ty ie)
-    with
-    | Exit -> None  (* error was already reported *)
-    | Env.Error msg -> error loc "%s" (Env.error_message msg); None
-
-(* Complete an array type with the size obtained from the initializer:
-   "int x[] = { 1, 2, 3 }" becomes "int x[3] = ..." *)
-
-let fixup_typ loc env ty init =
-  match unroll env ty, init with
-  | TArray(ty_elt, None, attr), Init_array il ->
-      if il = [] then warning loc "array of size 0";
-      TArray(ty_elt, Some(Int64.of_int(List.length il)), attr)
-  | _ -> ty
-
-(* Entry point *)
-
-let elab_initializer loc env root ty ie =
-  match elab_initial loc env root ty ie with
-  | None ->
-      (ty, None)
-  | Some init ->
-      (fixup_typ loc env ty init, Some init)
-
 (* Handling of __func__ (section 6.4.2.2) *)
 
 let __func__type_and_init s = 
diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index 41c00ba..3064e78 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -15,6 +15,9 @@
 
 (* Emulation of #pragma pack (experimental) *)
 
+(* Assumes: unblocked code.
+   Preserves: unblocked code. *)
+
 open Printf
 open Machine
 open C
@@ -303,6 +306,9 @@ let transf_expr loc env ctx e =
     | ECast(ty, e1) ->
         {edesc = ECast(ty, texp Val e1); etyp = e.etyp}
 
+    | ECompound _ ->
+        assert false    (* does not occur in unblocked code *)
+
     | ECall(e1, el) ->
         {edesc = ECall(texp Val e1, List.map (texp Val) el); etyp = e.etyp}
 
diff --git a/cparser/Rename.ml b/cparser/Rename.ml
index f4bab8e..2b7ec2c 100644
--- a/cparser/Rename.ml
+++ b/cparser/Rename.ml
@@ -105,6 +105,11 @@ and param env (id, ty) =
   else
     let (id', env') = rename env id in ((id', typ env' ty), env')
 
+let field env f =
+  { fld_name = f.fld_name;
+    fld_typ = typ env f.fld_typ;
+    fld_bitfield = f.fld_bitfield }
+
 let constant env = function
   | CEnum(id, v) -> CEnum(ident env id, v)
   | cst -> cst
@@ -121,18 +126,10 @@ and exp_desc env = function
   | EBinop(op, a, b, ty) -> EBinop(op, exp env a, exp env b, typ env ty)
   | EConditional(a, b, c) -> EConditional(exp env a, exp env b, exp env c)
   | ECast(ty, a) -> ECast(typ env ty, exp env a)
+  | ECompound(ty, ie) -> ECompound(typ env ty, init env ie)
   | ECall(a, al) -> ECall(exp env a, List.map (exp env) al)
 
-let optexp env = function
-  | None -> None
-  | Some a -> Some (exp env a)
-
-let field env f =
-  { fld_name = f.fld_name;
-    fld_typ = typ env f.fld_typ;
-    fld_bitfield = f.fld_bitfield }
-
-let rec init env = function
+and init env = function
   | Init_single e -> Init_single(exp env e)
   | Init_array il -> Init_array (List.map (init env) il)
   | Init_struct(id, il) ->
@@ -141,6 +138,10 @@ let rec init env = function
   | Init_union(id, f, i) ->
       Init_union(ident env id, field env f, init env i)
 
+let optexp env = function
+  | None -> None
+  | Some a -> Some (exp env a)
+
 let decl env (sto, id, ty, int) =
   let (id', env') = rename env id in
   ((sto,
diff --git a/cparser/StructReturn.ml b/cparser/StructReturn.ml
index e13b09d..228cc53 100644
--- a/cparser/StructReturn.ml
+++ b/cparser/StructReturn.ml
@@ -113,6 +113,8 @@ let rec transf_expr env ctx e =
        etyp = newty}
   | ECast(ty, e1) ->
       {edesc = ECast(transf_type env ty, transf_expr env Val e1); etyp = newty}
+  | ECompound(ty, ie) ->
+      {edesc = ECompound(transf_type env ty, transf_init env ie); etyp = newty}
   | ECall(fn, args) ->
       transf_call env ctx None fn args e.etyp
 
@@ -176,7 +178,7 @@ and transf_call env ctx opt_lhs fn args ty =
 
 (* Initializers *)
 
-let rec transf_init env = function
+and transf_init env = function
   | Init_single e ->
       Init_single (transf_expr env Val e)
   | Init_array il ->
diff --git a/cparser/Unblock.ml b/cparser/Unblock.ml
index 34d8cf8..ba8e379 100644
--- a/cparser/Unblock.ml
+++ b/cparser/Unblock.ml
@@ -22,31 +22,24 @@ open C
 open Cutil
 open Cerrors
 
-(* Convert an initializer to a list of assignments.
-   Prepend those assignments to the given statement. *)
+(* Convert an initializer to a list of assignment expressions. *)
 
-let sdoseq loc e s =
-  sseq loc {sdesc = Sdo e; sloc = loc} s
-
-let rec local_initializer loc env path init k =
+let rec local_initializer env path init k =
   match init with
   | Init_single e ->
-      sdoseq loc
-        { edesc = EBinop(Oassign, path, e, path.etyp); etyp = path.etyp }
-        k
+      { edesc = EBinop(Oassign, path, e, path.etyp); etyp = path.etyp } :: k
   | Init_array il ->
       let (ty_elt, sz) =
         match unroll env path.etyp with
         | TArray(ty_elt, Some sz, _) -> (ty_elt, sz)
-        | _ -> fatal_error "%aWrong type for array initializer" 
-                           formatloc loc in
+        | _ -> fatal_error "Wrong type for array initializer" in
       let rec array_init pos il =
         if pos >= sz then k else begin
           let (i1, il') =
             match il with
             | [] -> (default_init env ty_elt, [])
             | i1 :: il' -> (i1, il') in
-          local_initializer loc env
+          local_initializer env
             { edesc = EBinop(Oindex, path, intconst pos IInt, TPtr(ty_elt, []));
               etyp = ty_elt }
             i1
@@ -55,18 +48,37 @@ let rec local_initializer loc env path init k =
       array_init 0L il
   | Init_struct(id, fil) ->
       let field_init (fld, i) k =
-        local_initializer loc env
+        local_initializer env
           { edesc = EUnop(Odot fld.fld_name, path); etyp = fld.fld_typ } 
           i k in
       List.fold_right field_init fil k
   | Init_union(id, fld, i) ->
-      local_initializer loc env
+      local_initializer env
         { edesc = EUnop(Odot fld.fld_name, path); etyp = fld.fld_typ }
         i k
 
-(* Record new variables to be locally defined *)
+(* Prepend assignments to the given statement. *)
+
+let add_inits_stmt loc inits s =
+  List.fold_right
+    (fun e s -> sseq loc {sdesc = Sdo e; sloc = loc} s)
+    inits s
+
+(* Prepend assignments to the given expression. *)
+(* Associate to the left so that it prints more nicely *)
+
+let add_inits_expr inits e =
+  match inits with
+  | [] -> e
+  | i1 :: il ->
+      let comma a b =
+        { edesc = EBinop(Ocomma, a, b, b.etyp); etyp = b.etyp } in
+      comma (List.fold_left comma i1 il) e
+
+(* Record new variables to be locally or globally defined *)
 
 let local_variables = ref ([]: decl list)
+let global_variables = ref ([]: decl list)
 
 (* Note: "const int x = y - 1;" is legal, but we turn it into 
    "const int x; x = y - 1;", which is not.  Therefore, remove
@@ -75,7 +87,97 @@ let local_variables = ref ([]: decl list)
 
 let remove_const env ty = remove_attributes_type env [AConst] ty
 
-(* Process a variable declaration.
+(* Process a compound literal "(ty) { init }".
+   At top-level, within an initializer for a global variable,
+   it gives rise to a static global definition of a fresh variable,
+   initialized with "init".  The compound variable is replaced
+   by the fresh variable.
+   Within a function, it gives rise to a local variable
+   and an explicit initialization at the nearest sequence point. *)
+
+let process_compound_literal islocal env ty init =
+  let id = Env.fresh_ident "__compound" in
+  if islocal then begin
+    let ty' = remove_const env ty in
+    let e = {edesc = EVar id; etyp = ty'} in
+    local_variables :=
+      (Storage_default, id, ty', None) :: !local_variables;
+    (local_initializer env e init [], e)
+  end else begin
+    global_variables :=
+      (Storage_static, id, ty, Some init) :: !global_variables;
+    ([], {edesc = EVar id; etyp = ty})
+  end
+
+(* Elimination of compound literals within an expression.
+   Compound literals are turned into fresh variables, recorded in
+   [local_variables] or [global_variables] depending on [islocal].
+   For local variables, initializing assignments are added before
+   the expression and after sequence points in the expression.
+   Use only if [e] is a r-value. *)
+
+let rec expand_expr islocal env e =
+  let inits = ref [] in   (* accumulator for initializing assignments *)
+  let rec expand e =
+    match e.edesc with
+    | EConst _ | ESizeof _ | EAlignof _ | EVar _ -> e
+    | EUnop(op, e1) ->
+        {edesc = EUnop(op, expand e1); etyp = e.etyp}
+    | EBinop(op, e1, e2, ty) ->
+        let e1' = expand e1 in
+        let e2' =
+          match op with
+          | Ocomma | Ologand | Ologor -> expand_expr islocal env e2
+              (* Make sure the initializers of [e2] are performed in 
+                 sequential order, i.e. just before [e2] but after [e1]. *)
+          | _ -> expand e2 in
+        {edesc = EBinop(op, e1', e2', ty); etyp = e.etyp}
+    | EConditional(e1, e2, e3) ->
+        (* Same remark as above: initializers of [e2] and [e3] must
+           be performed after the conditional is resolved. *)
+        {edesc = EConditional(expand e1,
+                              expand_expr islocal env e2,
+                              expand_expr islocal env e3);
+         etyp = e.etyp}
+    | ECast(ty, e1) ->
+        {edesc = ECast(ty, expand e1); etyp = e.etyp}
+    | ECompound(ty, ie) ->
+        let ie' = expand_init islocal env ie in
+        let (l, e') = process_compound_literal islocal env ty ie' in
+        inits := l @ !inits;
+        e'
+    | ECall(e1, el) ->
+        {edesc = ECall(expand e1, List.map expand el); etyp = e.etyp}
+  in 
+    let e' = expand e in add_inits_expr !inits e'
+
+(* Elimination of compound literals within an initializer. *)
+
+and expand_init islocal env i =
+  let rec expand i =
+    match i with
+    (* The following "flattening" is not C99.  GCC documents it; whether
+       it implements it is unclear, Clang implements it.  At any rate,
+       it makes it possible to use compound literals in static initializers,
+       something that is not possible in C99 because compound literals
+       are not constant expressions.
+       Note that flattening is done for structs and unions but not for
+       arrays, because a compound literal of array type in r-value position
+       decays to a pointer to its first element. *)
+    | Init_single {edesc = ECompound(_, ((Init_struct _ | Init_union _) as i))} ->
+        expand i
+    | Init_single e ->
+        Init_single (expand_expr islocal env e)
+    | Init_array il ->
+        Init_array (List.map expand il)
+    | Init_struct(id, flds) ->
+        Init_struct(id, List.map (fun (f, i) -> (f, expand i)) flds)
+    | Init_union(id, fld, i) ->
+        Init_union(id, fld, expand i)
+  in
+    expand i
+
+(* Process a block-scoped variable declaration.
    The variable is entered in [local_variables].
    The initializer, if any, is converted into assignments and
    prepended to [k]. *)
@@ -86,32 +188,41 @@ let process_decl loc env (sto, id, ty, optinit) k =
   match optinit with
   | None -> k
   | Some init ->
-      local_initializer loc env { edesc = EVar id; etyp = ty' } init k
+      let init' = expand_init true env init in
+      let l = local_initializer env { edesc = EVar id; etyp = ty' } init' [] in
+      add_inits_stmt loc l k
 
 (* Simplification of blocks within a statement *)
 
 let rec unblock_stmt env s =
   match s.sdesc with
   | Sskip -> s
-  | Sdo e -> s
+  | Sdo e ->
+      {s with sdesc = Sdo(expand_expr true env e)}
   | Sseq(s1, s2) ->
       {s with sdesc = Sseq(unblock_stmt env s1, unblock_stmt env s2)}
   | Sif(e, s1, s2) -> 
-      {s with sdesc = Sif(e, unblock_stmt env s1, unblock_stmt env s2)}
+      {s with sdesc = Sif(expand_expr true env e,
+                          unblock_stmt env s1, unblock_stmt env s2)}
   | Swhile(e, s1) -> 
-      {s with sdesc = Swhile(e, unblock_stmt env s1)}
+      {s with sdesc = Swhile(expand_expr true env e, unblock_stmt env s1)}
   | Sdowhile(s1, e) ->
-      {s with sdesc = Sdowhile(unblock_stmt env s1, e)}
+      {s with sdesc = Sdowhile(unblock_stmt env s1, expand_expr true env e)}
   | Sfor(s1, e, s2, s3) ->
-      {s with sdesc = Sfor(unblock_stmt env s1, e, unblock_stmt env s2, unblock_stmt env s3)}
+      {s with sdesc = Sfor(unblock_stmt env s1,
+                           expand_expr true env e,
+                           unblock_stmt env s2,
+                           unblock_stmt env s3)}
   | Sbreak -> s
   | Scontinue -> s
   | Sswitch(e, s1) ->
-      {s with sdesc = Sswitch(e, unblock_stmt env s1)}
+      {s with sdesc = Sswitch(expand_expr true env e, unblock_stmt env s1)}
   | Slabeled(lbl, s1) -> 
       {s with sdesc = Slabeled(lbl, unblock_stmt env s1)}
   | Sgoto lbl -> s
-  | Sreturn opte -> s
+  | Sreturn None -> s
+  | Sreturn (Some e) ->
+      {s with sdesc = Sreturn(Some (expand_expr true env e))}
   | Sblock sl -> unblock_block env sl
   | Sdecl d -> assert false
   | Sasm _ -> s
@@ -123,7 +234,7 @@ and unblock_block env = function
   | s :: sl ->
       sseq s.sloc (unblock_stmt env s) (unblock_block env sl)
 
-(* Simplification of blocks within a function *)
+(* Simplification of blocks and compound literals within a function *)
 
 let unblock_fundef env f =
   local_variables := [];
@@ -132,7 +243,45 @@ let unblock_fundef env f =
   local_variables := [];
   { f with fd_locals = f.fd_locals @ decls; fd_body = body }
 
+(* Simplification of compound literals within a top-level declaration *)
+
+let unblock_decl loc env ((sto, id, ty, optinit) as d) =
+  match optinit with
+  | None -> [d]
+  | Some init ->
+      global_variables := [];
+      let init' = expand_init false env init in
+      let decls = !global_variables in
+      global_variables := [];
+      decls @ [(sto, id, ty, Some init')]
+
+(* Unblocking and simplification for whole files.
+   The environment is used for typedefs only, so we do not maintain
+   other declarations. *)
+
+let rec unblock_glob env accu = function
+  | [] -> List.rev accu
+  | g :: gl ->
+      match g.gdesc with
+      | Gdecl((sto, id, ty, init) as d) ->
+          let dl = unblock_decl g.gloc env d in
+          unblock_glob env
+            (List.rev_append
+               (List.map (fun d' -> {g with gdesc = Gdecl d'}) dl)
+               accu)
+            gl
+      | Gfundef f ->
+          let f' = unblock_fundef env f in
+          unblock_glob env ({g with gdesc = Gfundef f'} :: accu) gl
+      | Gtypedef(id, ty) ->
+          unblock_glob (Env.add_typedef env id ty) (g :: accu) gl
+      | Gcompositedecl _
+      | Gcompositedef _
+      | Genumdef _ 
+      | Gpragma _ ->
+          unblock_glob env (g :: accu) gl
+
 (* Entry point *)
 
 let program p =
-  Transform.program ~fundef:unblock_fundef p
+  unblock_glob (Builtins.environment()) [] p
diff --git a/test/regression/Makefile b/test/regression/Makefile
index bd99675..f4f9623 100644
--- a/test/regression/Makefile
+++ b/test/regression/Makefile
@@ -16,7 +16,7 @@ TESTS=int32 int64 floats floats-basics \
   expr1 expr6 funptr2 initializers initializers2 initializers3 \
   volatile1 volatile2 volatile3 \
   funct3 expr5 struct7 struct8 struct11 casts1 casts2 char1 \
-  sizeof1 sizeof2 binops bool for1 switch switch2
+  sizeof1 sizeof2 binops bool for1 switch switch2 compound
 
 # Can run, but only in compiled mode, and have reference output in Results
 
diff --git a/test/regression/Results/compound b/test/regression/Results/compound
new file mode 100644
index 0000000..b7d007b
--- /dev/null
+++ b/test/regression/Results/compound
@@ -0,0 +1,25 @@
+temp1 = "/temp/XXXXXX"
+temp2 = "/temp/XXXXXX"
+mutated temp1 = "/temp/!XXXXX"
+{x = 12, y = 45}
+{x = 42, y = -42}
+{from = {x = 42, y = 43}, to = {x = 44, y = 45}
+{from = {x = 39, y = 40}, to = {x = 41, y = 42}
+{x = -41, y = -41}
+ptrs contains 4 4 4 4 4
+ptrs contains 0 1 2 3 4
+structure = {a = 12, b = "a"}
+foo = { "x", "y", "z" }
+x = {a = 1, b[0] = 'a', b[1] = 'b'}
+{f = 0.250000}
+{i = 11}
+1 + 3 = 4
+{x = 0, y = 0}
+{x = 1, y = 1}
+{x = 2, y = 2}
+{x = 1, y = 0}
+{x = 0, y = 2}
+"first", "second", NULL
+77
+{ n = 3, p -> {0,1,2,0} }
+{ n = 4, p -> {0,1,2,3} }
diff --git a/test/regression/compound.c b/test/regression/compound.c
new file mode 100644
index 0000000..7c6bd2a
--- /dev/null
+++ b/test/regression/compound.c
@@ -0,0 +1,146 @@
+/* Testing compound literals */
+
+#include <stdio.h>
+
+struct point { int x, y; };
+struct line { struct point from, to; };
+
+void printpoint (struct point p)
+{
+  printf("{x = %d, y = %d}\n", p.x, p.y);
+}
+
+void printpointref (struct point * p)
+{
+  printf("{x = %d, y = %d}\n", p->x, p->y);
+}
+
+void printline (struct line l)
+{
+  printf("{from = {x = %d, y = %d}, to = {x = %d, y = %d}\n",
+         l.from.x, l.from.y, l.to.x, l.to.y);
+}
+
+static inline struct point diff(struct point a, struct point b)
+{
+  return (struct point){ b.x - a.x, b.y - a.y };
+}
+
+/* H&S section 7.4.5 */
+
+char * temp1 = (char []) {"/temp/XXXXXX"};
+char * temp2 = "/temp/XXXXXX";
+
+int pow2(int n)
+{
+  if (n >= 0 && n <= 7)
+    return (const int []) {1,2,4,8,16,32,64,128} [n];
+  else
+    return -1;
+}
+
+void test1(int n)
+{
+  printf("temp1 = \"%s\"\n", temp1);
+  printf("temp2 = \"%s\"\n", temp2);
+  temp1[6] = '!';
+  printf("mutated temp1 = \"%s\"\n", temp1);
+
+  printpoint((struct point){.x=12, .y=n+3});
+  printpointref(&(struct point){n,-n});
+  printline((struct line){n,n+1,n+2,n+3});
+  printline((struct line){.from = (struct point){n-3,n-2},
+                          .to   = (struct point){n-1,n}});
+  printpoint(diff((struct point){n,n}, (struct point){1,1}));
+  int * ptrs[5];
+  int i = 0;
+ again:
+  ptrs[i] = (int [1]){i};
+  if (++i < 5) goto again;
+  printf("ptrs contains %d %d %d %d %d\n",
+         *(ptrs[0]), *(ptrs[1]), *(ptrs[2]), *(ptrs[3]),*(ptrs[4]));
+  i = 0;
+  ptrs[0] = (int [1]){i++};
+  ptrs[1] = (int [1]){i++};
+  ptrs[2] = (int [1]){i++};
+  ptrs[3] = (int [1]){i++};
+  ptrs[4] = (int [1]){i++};
+  printf("ptrs contains %d %d %d %d %d\n",
+         *(ptrs[0]), *(ptrs[1]), *(ptrs[2]), *(ptrs[3]),*(ptrs[4]));
+}
+
+/* Examples from GCC's manual */
+
+struct foo { int a; char b[2]; } structure;
+
+char **foo = (char *[]) { "x", "y", "z" };
+
+static struct foo x = (struct foo) {1, 'a', 'b'};
+// Dubious examples: GCC refuses them, Clang warns.
+// static int y[] = (int []) {1, 2, 3};
+// static int z[] = (int [3]) {1};
+
+void test2(int n)
+{
+  structure = (struct foo) {n, 'a', 0};
+  printf("structure = {a = %d, b = \"%s\"}\n", structure.a, structure.b);
+  printf("foo = { \"%s\", \"%s\", \"%s\" }\n", foo[0], foo[1], foo[2]);
+  printf("x = {a = %d, b[0] = '%c', b[1] = '%c'}\n", x.a, x.b[0], x.b[1]);
+}
+
+/* Example gathered from various places */
+
+union U { float f; int i; };
+
+void printU(int kind, const union U u)
+{
+  switch (kind) {
+  case 0:  printf("{f = %f}\n", u.f); break;
+  case 1:  printf("{i = %d}\n", u.i); break;
+  }
+}
+
+struct list { char * value; struct list * next; };
+
+void printlist(struct list * l)
+{
+  for (; l != NULL; l = l->next) printf("\"%s\", ", l->value);
+  printf("NULL\n");
+}
+
+void printintref(int * p)
+{
+  printf("%d\n", *p);
+}
+
+struct S { int n; int *p; };
+
+void printS(struct S s)
+{
+  printf("{ n = %d, p -> {%d,%d,%d,%d} }\n",
+         s.n, s.p[0], s.p[1], s.p[2], s.p[3]);
+}
+
+void test3(void)
+{
+  printU(0, (const union U){0.25});
+  printU(1, (const union U){.i = 11});
+  printf("1 + 3 = %d\n", (int){1} + (int){3});
+  for (int i = 0; i < 3; i++) printpoint((struct point){i,i});
+  printpoint((struct point){1});
+  printpoint((struct point){.y=2});
+  printlist(&((struct list){"first", &((struct list){"second", NULL})}));
+  printintref(&((int){77}));
+  struct S s = (struct S) {3, (int[4]){0,1,2}};
+  printS(s);
+  printS((struct S) {4, (int[]){0,1,2,3}});
+}
+
+int main(void)
+{
+  test1(42);
+  test2(12);
+  test3();
+  return 0;
+}
+