diff options
Diffstat (limited to 'cparser')
-rw-r--r-- | cparser/Cutil.ml | 10 | ||||
-rw-r--r-- | cparser/PackedStructs.ml | 2 | ||||
-rw-r--r-- | cparser/StructReturn.ml | 6 | ||||
-rw-r--r-- | cparser/Transform.ml | 33 | ||||
-rw-r--r-- | cparser/Transform.mli | 6 | ||||
-rw-r--r-- | cparser/Unblock.ml | 8 |
6 files changed, 46 insertions, 19 deletions
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 4d6d2137..846010b3 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -964,8 +964,7 @@ let rec subst_stmt phi s = | Sskip | Sbreak | Scontinue - | Sgoto _ - | Sasm _ -> s.sdesc + | Sgoto _ -> s.sdesc | Sdo e -> Sdo (subst_expr phi e) | Sseq(s1, s2) -> Sseq (subst_stmt phi s1, subst_stmt phi s2) | Sif(e, s1, s2) -> @@ -981,6 +980,13 @@ let rec subst_stmt phi s = | Sreturn (Some e) -> Sreturn (Some (subst_expr phi e)) | Sblock sl -> Sblock (List.map (subst_stmt phi) sl) | Sdecl d -> Sdecl (subst_decl phi d) + | Sasm(attr, template, outputs, inputs, clob) -> + let subst_asm_operand (lbl, cstr, e) = + (lbl, cstr, subst_expr phi e) in + Sasm(attr, template, + List.map subst_asm_operand outputs, + List.map subst_asm_operand inputs, + clob) } diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml index 1f602fc1..ca6c9da5 100644 --- a/cparser/PackedStructs.ml +++ b/cparser/PackedStructs.ml @@ -317,7 +317,7 @@ let transf_expr loc env ctx e = (* Statements *) let transf_stmt env s = - Transform.stmt transf_expr env s + Transform.stmt ~expr:transf_expr env s (* Functions *) diff --git a/cparser/StructReturn.ml b/cparser/StructReturn.ml index 8bfc6954..660f1d9b 100644 --- a/cparser/StructReturn.ml +++ b/cparser/StructReturn.ml @@ -423,6 +423,7 @@ let transf_decl env (sto, id, ty, init) = let transf_funbody env body optres = let transf_expr ctx e = transf_expr env ctx e in +let transf_asm_operand (lbl, cstr, e) = (lbl, cstr, transf_expr Val e) in (* Function returns: return kind scalar -> return e @@ -484,7 +485,10 @@ let rec transf_stmt s = {s with sdesc = Sblock(List.map transf_stmt sl)} | Sdecl d -> {s with sdesc = Sdecl(transf_decl env d)} - | Sasm _ -> s + | Sasm(attr, template, outputs, inputs, clob) -> + {s with sdesc = Sasm(attr, template, + List.map transf_asm_operand outputs, + List.map transf_asm_operand inputs, clob)} in transf_stmt body diff --git a/cparser/Transform.ml b/cparser/Transform.ml index 3b6f10f6..6cdd8a6b 100644 --- a/cparser/Transform.ml +++ b/cparser/Transform.ml @@ -138,37 +138,46 @@ let expand_postincrdecr ~read ~write env ctx op l = ecomma (eassign tmp (read l)) (ecomma (write l newval) tmp)) (* Generic transformation of a statement, transforming expressions within - and preserving the statement structure. Applies only to unblocked code. *) + and preserving the statement structure. + If [decl] is not given, it applies only to unblocked code. *) -let stmt trexpr env s = +let stmt ~expr ?(decl = fun env decl -> assert false) env s = let rec stm s = match s.sdesc with | Sskip -> s | Sdo e -> - {s with sdesc = Sdo(trexpr s.sloc env Effects e)} + {s with sdesc = Sdo(expr s.sloc env Effects e)} | Sseq(s1, s2) -> {s with sdesc = Sseq(stm s1, stm s2)} | Sif(e, s1, s2) -> - {s with sdesc = Sif(trexpr s.sloc env Val e, stm s1, stm s2)} + {s with sdesc = Sif(expr s.sloc env Val e, stm s1, stm s2)} | Swhile(e, s1) -> - {s with sdesc = Swhile(trexpr s.sloc env Val e, stm s1)} + {s with sdesc = Swhile(expr s.sloc env Val e, stm s1)} | Sdowhile(s1, e) -> - {s with sdesc = Sdowhile(stm s1, trexpr s.sloc env Val e)} + {s with sdesc = Sdowhile(stm s1, expr s.sloc env Val e)} | Sfor(s1, e, s2, s3) -> - {s with sdesc = Sfor(stm s1, trexpr s.sloc env Val e, stm s2, stm s3)} + {s with sdesc = Sfor(stm s1, expr s.sloc env Val e, stm s2, stm s3)} | Sbreak -> s | Scontinue -> s | Sswitch(e, s1) -> - {s with sdesc = Sswitch(trexpr s.sloc env Val e, stm s1)} + {s with sdesc = Sswitch(expr s.sloc env Val e, stm s1)} | Slabeled(lbl, s) -> {s with sdesc = Slabeled(lbl, stm s)} | Sgoto lbl -> s | Sreturn None -> s | Sreturn (Some e) -> - {s with sdesc = Sreturn(Some(trexpr s.sloc env Val e))} - | Sasm _ -> s - | Sblock _ | Sdecl _ -> - assert false (* should not occur in unblocked code *) + {s with sdesc = Sreturn(Some(expr s.sloc env Val e))} + | Sasm(attr, template, outputs, inputs, clob) -> + let asm_operand (lbl, cstr, e) = + (lbl, cstr, expr s.sloc env Val e) in + {s with sdesc = Sasm(attr, template, + List.map asm_operand outputs, + List.map asm_operand inputs, clob)} + | Sblock sl -> + {s with sdesc = Sblock (List.map stm sl)} + | Sdecl d -> + {s with sdesc = Sdecl (decl env d)} + in stm s (* Generic transformation of a function definition *) diff --git a/cparser/Transform.mli b/cparser/Transform.mli index 718a2f9c..57a4737b 100644 --- a/cparser/Transform.mli +++ b/cparser/Transform.mli @@ -50,8 +50,10 @@ val expand_postincrdecr : (** Generic transformation of a statement *) -val stmt : (C.location -> Env.t -> context -> C.exp -> C.exp) -> - Env.t -> C.stmt -> C.stmt +val stmt : + expr: (C.location -> Env.t -> context -> C.exp -> C.exp) -> + ?decl: (Env.t -> C.decl -> C.decl) -> + Env.t -> C.stmt -> C.stmt (** Generic transformation of a function definition *) diff --git a/cparser/Unblock.ml b/cparser/Unblock.ml index 4013db9b..91f50552 100644 --- a/cparser/Unblock.ml +++ b/cparser/Unblock.ml @@ -225,7 +225,13 @@ let rec unblock_stmt env s = {s with sdesc = Sreturn(Some (expand_expr true env e))} | Sblock sl -> unblock_block env sl | Sdecl d -> assert false - | Sasm _ -> s + | Sasm(attr, template, outputs, inputs, clob) -> + let expand_asm_operand (lbl, cstr, e) = + (lbl, cstr, expand_expr true env e) in + {s with sdesc = Sasm(attr, template, + List.map expand_asm_operand outputs, + List.map expand_asm_operand inputs, clob)} + and unblock_block env = function | [] -> sskip |