X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/978fd7e56b141f7e4c8930acdbf0a806489e63a5..abad11c5570b7b9bbae5ff92b3050cf68fe3fd14:/parsing_cocci/ast0toast.ml
diff --git a/parsing_cocci/ast0toast.ml b/parsing_cocci/ast0toast.ml
index dca8b8e..820f848 100644
--- a/parsing_cocci/ast0toast.ml
+++ b/parsing_cocci/ast0toast.ml
@@ -1,25 +1,30 @@
(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see .
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
-
-
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see .
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
+# 0 "./ast0toast.ml"
(* Arities matter for the minus slice, but not for the plus slice. *)
(* + only allowed on code in a nest (in_nest = true). ? only allowed on
@@ -29,7 +34,6 @@ module Ast0 = Ast0_cocci
module Ast = Ast_cocci
module V0 = Visitor_ast0
module VT0 = Visitor_ast0_types
-module V = Visitor_ast
let unitary = Type_cocci.Unitary
@@ -53,7 +57,7 @@ let inline_mcodes =
match (Ast0.get_mcodekind e) with
Ast0.MINUS(replacements) ->
(match !replacements with
- ([],_) -> ()
+ (Ast.NOREPLACEMENT,_) -> ()
| replacements ->
let minus_try = function
(true,mc) ->
@@ -94,83 +98,106 @@ let inline_mcodes =
else starter @ ender in
(lst,
{endinfo with Ast0.tline_start = startinfo.Ast0.tline_start}) in
- let attach_bef bef beforeinfo = function
+ let attach_bef bef beforeinfo befit = function
(true,mcl) ->
List.iter
(function
Ast0.MINUS(mreplacements) ->
- let (mrepl,tokeninfo) = !mreplacements in
- mreplacements := concat bef beforeinfo mrepl tokeninfo
+ (match !mreplacements with
+ (Ast.NOREPLACEMENT,tokeninfo) ->
+ mreplacements :=
+ (Ast.REPLACEMENT(bef,befit),beforeinfo)
+ | (Ast.REPLACEMENT(anythings,it),tokeninfo) ->
+ let (newbef,newinfo) =
+ concat bef beforeinfo anythings tokeninfo in
+ let it = Ast.lub_count befit it in
+ mreplacements :=
+ (Ast.REPLACEMENT(newbef,it),newinfo))
| Ast0.CONTEXT(mbefaft) ->
(match !mbefaft with
- (Ast.BEFORE(mbef),mbeforeinfo,a) ->
+ (Ast.BEFORE(mbef,it),mbeforeinfo,a) ->
let (newbef,newinfo) =
concat bef beforeinfo mbef mbeforeinfo in
- mbefaft := (Ast.BEFORE(newbef),newinfo,a)
- | (Ast.AFTER(maft),_,a) ->
+ let it = Ast.lub_count befit it in
+ mbefaft := (Ast.BEFORE(newbef,it),newinfo,a)
+ | (Ast.AFTER(maft,it),_,a) ->
+ let it = Ast.lub_count befit it in
mbefaft :=
- (Ast.BEFOREAFTER(bef,maft),beforeinfo,a)
- | (Ast.BEFOREAFTER(mbef,maft),mbeforeinfo,a) ->
+ (Ast.BEFOREAFTER(bef,maft,it),beforeinfo,a)
+ | (Ast.BEFOREAFTER(mbef,maft,it),mbeforeinfo,a) ->
let (newbef,newinfo) =
concat bef beforeinfo mbef mbeforeinfo in
+ let it = Ast.lub_count befit it in
mbefaft :=
- (Ast.BEFOREAFTER(newbef,maft),newinfo,a)
+ (Ast.BEFOREAFTER(newbef,maft,it),newinfo,a)
| (Ast.NOTHING,_,a) ->
- mbefaft := (Ast.BEFORE(bef),beforeinfo,a))
+ mbefaft :=
+ (Ast.BEFORE(bef,befit),beforeinfo,a))
| _ -> failwith "unexpected annotation")
mcl
| _ ->
Printf.printf "before %s\n" (Dumper.dump bef);
failwith
"context tree should not have bad code before" in
- let attach_aft aft afterinfo = function
+ let attach_aft aft afterinfo aftit = function
(true,mcl) ->
List.iter
(function
Ast0.MINUS(mreplacements) ->
- let (mrepl,tokeninfo) = !mreplacements in
- mreplacements := concat mrepl tokeninfo aft afterinfo
+ (match !mreplacements with
+ (Ast.NOREPLACEMENT,tokeninfo) ->
+ mreplacements :=
+ (Ast.REPLACEMENT(aft,aftit),afterinfo)
+ | (Ast.REPLACEMENT(anythings,it),tokeninfo) ->
+ let (newaft,newinfo) =
+ concat anythings tokeninfo aft afterinfo in
+ let it = Ast.lub_count aftit it in
+ mreplacements :=
+ (Ast.REPLACEMENT(newaft,it),newinfo))
| Ast0.CONTEXT(mbefaft) ->
(match !mbefaft with
- (Ast.BEFORE(mbef),b,_) ->
+ (Ast.BEFORE(mbef,it),b,_) ->
+ let it = Ast.lub_count aftit it in
mbefaft :=
- (Ast.BEFOREAFTER(mbef,aft),b,afterinfo)
- | (Ast.AFTER(maft),b,mafterinfo) ->
+ (Ast.BEFOREAFTER(mbef,aft,it),b,afterinfo)
+ | (Ast.AFTER(maft,it),b,mafterinfo) ->
let (newaft,newinfo) =
concat maft mafterinfo aft afterinfo in
- mbefaft := (Ast.AFTER(newaft),b,newinfo)
- | (Ast.BEFOREAFTER(mbef,maft),b,mafterinfo) ->
+ let it = Ast.lub_count aftit it in
+ mbefaft := (Ast.AFTER(newaft,it),b,newinfo)
+ | (Ast.BEFOREAFTER(mbef,maft,it),b,mafterinfo) ->
let (newaft,newinfo) =
concat maft mafterinfo aft afterinfo in
+ let it = Ast.lub_count aftit it in
mbefaft :=
- (Ast.BEFOREAFTER(mbef,newaft),b,newinfo)
+ (Ast.BEFOREAFTER(mbef,newaft,it),b,newinfo)
| (Ast.NOTHING,b,_) ->
- mbefaft := (Ast.AFTER(aft),b,afterinfo))
+ mbefaft := (Ast.AFTER(aft,aftit),b,afterinfo))
| _ -> failwith "unexpected annotation")
mcl
| _ ->
failwith
"context tree should not have bad code after" in
(match !befaft with
- (Ast.BEFORE(bef),beforeinfo,_) ->
- attach_bef bef beforeinfo
+ (Ast.BEFORE(bef,it),beforeinfo,_) ->
+ attach_bef bef beforeinfo it
(einfo.Ast0.attachable_start,einfo.Ast0.mcode_start)
- | (Ast.AFTER(aft),_,afterinfo) ->
- attach_aft aft afterinfo
+ | (Ast.AFTER(aft,it),_,afterinfo) ->
+ attach_aft aft afterinfo it
(einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
- | (Ast.BEFOREAFTER(bef,aft),beforeinfo,afterinfo) ->
- attach_bef bef beforeinfo
+ | (Ast.BEFOREAFTER(bef,aft,it),beforeinfo,afterinfo) ->
+ attach_bef bef beforeinfo it
(einfo.Ast0.attachable_start,einfo.Ast0.mcode_start);
- attach_aft aft afterinfo
+ attach_aft aft afterinfo it
(einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
| (Ast.NOTHING,_,_) -> ())
- | Ast0.PLUS -> () in
+ | Ast0.PLUS _ -> () in
V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode mcode
do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
- do_nothing do_nothing do_nothing
+ do_nothing do_nothing do_nothing do_nothing
(* --------------------------------------------------------------------- *)
(* For function declarations. Can't use the mcode at the root, because that
@@ -183,40 +210,62 @@ let check_allminus =
let option_default = true in
let mcode (_,_,_,mc,_,_) =
match mc with
- Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = []
+ Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = Ast.NOREPLACEMENT
| _ -> false in
- (* special case for disj *)
+ (* special case for disj and asExpr etc *)
+ let ident r k e =
+ match Ast0.unwrap e with
+ Ast0.DisjId(starter,id_list,mids,ender) ->
+ List.for_all r.VT0.combiner_rec_ident id_list
+ | Ast0.AsIdent(id,asid) -> k id
+ | _ -> k e in
+
let expression r k e =
match Ast0.unwrap e with
Ast0.DisjExpr(starter,expr_list,mids,ender) ->
List.for_all r.VT0.combiner_rec_expression expr_list
+ | Ast0.AsExpr(exp,asexp) -> k exp
| _ -> k e in
let declaration r k e =
match Ast0.unwrap e with
Ast0.DisjDecl(starter,decls,mids,ender) ->
List.for_all r.VT0.combiner_rec_declaration decls
+ | Ast0.AsDecl(decl,asdecl) -> k decl
| _ -> k e in
let typeC r k e =
match Ast0.unwrap e with
Ast0.DisjType(starter,decls,mids,ender) ->
List.for_all r.VT0.combiner_rec_typeC decls
+ | Ast0.AsType(ty,asty) -> k ty
+ | _ -> k e in
+
+ let initialiser r k e =
+ match Ast0.unwrap e with
+ Ast0.AsInit(init,asinit) -> k init
| _ -> k e in
let statement r k e =
match Ast0.unwrap e with
Ast0.Disj(starter,statement_dots_list,mids,ender) ->
List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list
+ | Ast0.AsStmt(stmt,asstmt) -> k stmt
+ | _ -> k e in
+
+ let case_line r k e =
+ match Ast0.unwrap e with
+ Ast0.DisjCase(starter,case_lines,mids,ender) ->
+ List.for_all r.VT0.combiner_rec_case_line case_lines
| _ -> k e in
V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode mcode
donothing donothing donothing donothing donothing donothing
- donothing expression typeC donothing donothing declaration
- statement donothing donothing
+ ident expression typeC initialiser donothing declaration
+ statement donothing case_line donothing
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
@@ -237,28 +286,50 @@ let convert_info info =
{ Ast.line = info.Ast0.pos_info.Ast0.line_start;
Ast.column = info.Ast0.pos_info.Ast0.column;
Ast.strbef = strings_to_s info.Ast0.strings_before;
- Ast.straft = strings_to_s info.Ast0.strings_after;}
+ Ast.straft = strings_to_s info.Ast0.strings_after;
+ }
let convert_mcodekind adj = function
Ast0.MINUS(replacements) ->
let (replacements,_) = !replacements in
- Ast.MINUS(Ast.NoPos,[],adj,replacements)
- | Ast0.PLUS -> Ast.PLUS
+ Ast.MINUS(Ast.NoPos,[],Ast.ADJ adj,replacements)
+ | Ast0.PLUS count -> Ast.PLUS count
| Ast0.CONTEXT(befaft) ->
- let (befaft,_,_) = !befaft in Ast.CONTEXT(Ast.NoPos,befaft)
+ let (befaft,_,_) = !befaft in
+ Ast.CONTEXT(Ast.NoPos,befaft)
| Ast0.MIXED(_) -> failwith "not possible for mcode"
+let convert_fake_mcode (_,mc,adj) = convert_mcodekind adj mc
+
+let convert_allminus_mcodekind allminus = function
+ Ast0.CONTEXT(befaft) ->
+ let (befaft,_,_) = !befaft in
+ if allminus
+ then
+ (match befaft with
+ Ast.NOTHING ->
+ Ast.MINUS(Ast.NoPos,[],Ast.ALLMINUS,Ast.NOREPLACEMENT)
+ | Ast.BEFORE(a,ct) | Ast.AFTER(a,ct) ->
+ Ast.MINUS(Ast.NoPos,[],Ast.ALLMINUS,Ast.REPLACEMENT(a,ct))
+ | Ast.BEFOREAFTER(b,a,ct) ->
+ Ast.MINUS(Ast.NoPos,[],Ast.ALLMINUS,Ast.REPLACEMENT(b@a,ct)))
+ else Ast.CONTEXT(Ast.NoPos,befaft)
+ | _ -> failwith "convert_allminus_mcodekind: unexpected mcodekind"
+
let pos_mcode(term,_,info,mcodekind,pos,adj) =
(* avoids a recursion problem *)
- (term,convert_info info,convert_mcodekind adj mcodekind,Ast.NoMetaPos)
+ (term,convert_info info,convert_mcodekind adj mcodekind,[])
let mcode (term,_,info,mcodekind,pos,adj) =
let pos =
- match !pos with
- Ast0.MetaPos(pos,constraints,per) ->
- Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false)
- | _ -> Ast.NoMetaPos in
- (term,convert_info info,convert_mcodekind adj mcodekind,pos)
+ List.fold_left
+ (function prev ->
+ function
+ Ast0.MetaPosTag(Ast0.MetaPos(pos,constraints,per)) ->
+ (Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false))::prev
+ | _ -> prev)
+ [] !pos in
+ (term,convert_info info,convert_mcodekind adj mcodekind,List.rev pos)
(* --------------------------------------------------------------------- *)
(* Dots *)
@@ -291,15 +362,16 @@ and ident i =
rewrap i (do_isos (Ast0.get_iso i))
(match Ast0.unwrap i with
Ast0.Id(name) -> Ast.Id(mcode name)
- | Ast0.MetaId(name,constraints,_) ->
- let constraints = List.map ident constraints in
+ | Ast0.DisjId(_,id_list,_,_) ->
+ Ast.DisjId(List.map ident id_list)
+ | Ast0.MetaId(name,constraints,_,_) ->
Ast.MetaId(mcode name,constraints,unitary,false)
| Ast0.MetaFunc(name,constraints,_) ->
- let constraints = List.map ident constraints in
Ast.MetaFunc(mcode name,constraints,unitary,false)
| Ast0.MetaLocalFunc(name,constraints,_) ->
- let constraints = List.map ident constraints in
Ast.MetaLocalFunc(mcode name,constraints,unitary,false)
+ | Ast0.AsIdent(id,asid) ->
+ Ast.AsIdent(ident id,ident asid)
| Ast0.OptIdent(id) -> Ast.OptIdent(ident id)
| Ast0.UniqueIdent(id) -> Ast.UniqueIdent(ident id))
@@ -321,6 +393,8 @@ and expression e =
Ast.FunCall(fn,lp,args,rp)
| Ast0.Assignment(left,op,right,simple) ->
Ast.Assignment(expression left,mcode op,expression right,simple)
+ | Ast0.Sequence(left,op,right) ->
+ Ast.Sequence(expression left,mcode op,expression right)
| Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
let exp1 = expression exp1 in
let why = mcode why in
@@ -347,29 +421,35 @@ and expression e =
| Ast0.RecordPtAccess(exp,ar,field) ->
Ast.RecordPtAccess(expression exp,mcode ar,ident field)
| Ast0.Cast(lp,ty,rp,exp) ->
- Ast.Cast(mcode lp,typeC ty,mcode rp,expression exp)
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.Cast(mcode lp,typeC allminus ty,mcode rp,expression exp)
| Ast0.SizeOfExpr(szf,exp) ->
Ast.SizeOfExpr(mcode szf,expression exp)
| Ast0.SizeOfType(szf,lp,ty,rp) ->
- Ast.SizeOfType(mcode szf, mcode lp,typeC ty,mcode rp)
- | Ast0.TypeExp(ty) -> Ast.TypeExp(typeC ty)
- | Ast0.MetaErr(name,constraints,_) ->
- let constraints = List.map expression constraints in
- Ast.MetaErr(mcode name,constraints,unitary,false)
- | Ast0.MetaExpr(name,constraints,ty,form,_) ->
- let constraints = List.map expression constraints in
- Ast.MetaExpr(mcode name,constraints,unitary,ty,form,false)
- | Ast0.MetaExprList(name,Some lenname,_) ->
- Ast.MetaExprList(mcode name,Some (mcode lenname,unitary,false),
- unitary,false)
- | Ast0.MetaExprList(name,None,_) ->
- Ast.MetaExprList(mcode name,None,unitary,false)
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.SizeOfType(mcode szf, mcode lp,typeC allminus ty,mcode rp)
+ | Ast0.TypeExp(ty) ->
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.TypeExp(typeC allminus ty)
+ | Ast0.Constructor(lp,ty,rp,init) ->
+ let allminus = check_allminus.VT0.combiner_rec_expression e in
+ Ast.Constructor(mcode lp,typeC allminus ty,mcode rp,initialiser init)
+ | Ast0.MetaErr(name,cstrts,_) ->
+ Ast.MetaErr(mcode name,constraints cstrts,unitary,false)
+ | Ast0.MetaExpr(name,cstrts,ty,form,_) ->
+ Ast.MetaExpr(mcode name,constraints cstrts,unitary,ty,form,false)
+ | Ast0.MetaExprList(name,lenname,_) ->
+ Ast.MetaExprList(mcode name,do_lenname lenname,unitary,false)
+ | Ast0.AsExpr(expr,asexpr) ->
+ Ast.AsExpr(expression expr,expression asexpr)
| Ast0.EComma(cm) -> Ast.EComma(mcode cm)
| Ast0.DisjExpr(_,exps,_,_) ->
Ast.DisjExpr(List.map expression exps)
- | Ast0.NestExpr(_,exp_dots,_,whencode,multi) ->
+ | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
+ let starter = mcode starter in
let whencode = get_option expression whencode in
- Ast.NestExpr(dots expression exp_dots,whencode,multi)
+ let ender = mcode ender in
+ Ast.NestExpr(starter,dots expression exp_dots,ender,whencode,multi)
| Ast0.Edots(dots,whencode) ->
let dots = mcode dots in
let whencode = get_option expression whencode in
@@ -388,12 +468,24 @@ and expression e =
and expression_dots ed = dots expression ed
+and constraints c =
+ match c with
+ Ast0.NoConstraint -> Ast.NoConstraint
+ | Ast0.NotIdCstrt idctrt -> Ast.NotIdCstrt idctrt
+ | Ast0.NotExpCstrt exps -> Ast.NotExpCstrt (List.map expression exps)
+ | Ast0.SubExpCstrt ids -> Ast.SubExpCstrt ids
+
+and do_lenname = function
+ Ast0.MetaListLen(nm) -> Ast.MetaListLen(mcode nm,unitary,false)
+ | Ast0.CstListLen n -> Ast.CstListLen n
+ | Ast0.AnyListLen -> Ast.AnyListLen
+
(* --------------------------------------------------------------------- *)
(* Types *)
and rewrap_iso t t1 = rewrap t (do_isos (Ast0.get_iso t)) t1
-and typeC t =
+and typeC allminus t =
rewrap t (do_isos (Ast0.get_iso t))
(match Ast0.unwrap t with
Ast0.ConstVol(cv,ty) ->
@@ -408,7 +500,8 @@ and typeC t =
List.map
(function ty ->
Ast.Type
- (Some (mcode cv),rewrap_iso ty (base_typeC ty)))
+ (allminus, Some (mcode cv),
+ rewrap_iso ty (base_typeC allminus ty)))
(collect_disjs ty) in
(* one could worry that isos are lost because we flatten the
disjunctions. but there should not be isos on the disjunctions
@@ -419,36 +512,44 @@ and typeC t =
| Ast0.BaseType(_) | Ast0.Signed(_,_) | Ast0.Pointer(_,_)
| Ast0.FunctionPointer(_,_,_,_,_,_,_) | Ast0.FunctionType(_,_,_,_)
| Ast0.Array(_,_,_,_) | Ast0.EnumName(_,_) | Ast0.StructUnionName(_,_)
- | Ast0.StructUnionDef(_,_,_,_) | Ast0.TypeName(_) | Ast0.MetaType(_,_) ->
- Ast.Type(None,rewrap t no_isos (base_typeC t))
- | Ast0.DisjType(_,types,_,_) -> Ast.DisjType(List.map typeC types)
- | Ast0.OptType(ty) -> Ast.OptType(typeC ty)
- | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC ty))
-
-and base_typeC t =
+ | Ast0.StructUnionDef(_,_,_,_) | Ast0.EnumDef(_,_,_,_)
+ | Ast0.TypeName(_) | Ast0.MetaType(_,_) ->
+ Ast.Type(allminus,None,rewrap t no_isos (base_typeC allminus t))
+ | Ast0.DisjType(_,types,_,_) ->
+ Ast.DisjType(List.map (typeC allminus) types)
+ | Ast0.AsType(ty,asty) ->
+ Ast.AsType(typeC allminus ty,typeC allminus asty)
+ | Ast0.OptType(ty) -> Ast.OptType(typeC allminus ty)
+ | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC allminus ty))
+
+and base_typeC allminus t =
match Ast0.unwrap t with
Ast0.BaseType(ty,strings) -> Ast.BaseType(ty,List.map mcode strings)
| Ast0.Signed(sgn,ty) ->
- Ast.SignedT(mcode sgn,
- get_option (function x -> rewrap_iso x (base_typeC x)) ty)
- | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC ty,mcode star)
+ Ast.SignedT
+ (mcode sgn,
+ get_option (function x -> rewrap_iso x (base_typeC allminus x)) ty)
+ | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC allminus ty,mcode star)
| Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
Ast.FunctionPointer
- (typeC ty,mcode lp1,mcode star,mcode rp1,
+ (typeC allminus ty,mcode lp1,mcode star,mcode rp1,
mcode lp2,parameter_list params,mcode rp2)
| Ast0.FunctionType(ret,lp,params,rp) ->
let allminus = check_allminus.VT0.combiner_rec_typeC t in
Ast.FunctionType
- (allminus,get_option typeC ret,mcode lp,
+ (allminus,get_option (typeC allminus) ret,mcode lp,
parameter_list params,mcode rp)
| Ast0.Array(ty,lb,size,rb) ->
- Ast.Array(typeC ty,mcode lb,get_option expression size,mcode rb)
+ Ast.Array(typeC allminus ty,mcode lb,get_option expression size,
+ mcode rb)
| Ast0.EnumName(kind,name) ->
- Ast.EnumName(mcode kind,ident name)
+ Ast.EnumName(mcode kind,get_option ident name)
+ | Ast0.EnumDef(ty,lb,ids,rb) ->
+ Ast.EnumDef(typeC allminus ty,mcode lb,dots expression ids,mcode rb)
| Ast0.StructUnionName(kind,name) ->
Ast.StructUnionName(mcode kind,get_option ident name)
| Ast0.StructUnionDef(ty,lb,decls,rb) ->
- Ast.StructUnionDef(typeC ty,mcode lb,
+ Ast.StructUnionDef(typeC allminus ty,mcode lb,
dots declaration decls,
mcode rb)
| Ast0.TypeName(name) -> Ast.TypeName(mcode name)
@@ -464,9 +565,16 @@ and base_typeC t =
and declaration d =
rewrap d (do_isos (Ast0.get_iso d))
(match Ast0.unwrap d with
- Ast0.Init(stg,ty,id,eq,ini,sem) ->
+ Ast0.MetaDecl(name,_) -> Ast.MetaDecl(mcode name,unitary,false)
+ | Ast0.MetaField(name,_) -> Ast.MetaField(mcode name,unitary,false)
+ | Ast0.MetaFieldList(name,lenname,_) ->
+ Ast.MetaFieldList(mcode name,do_lenname lenname,unitary,false)
+ | Ast0.AsDecl(decl,asdecl) ->
+ Ast.AsDecl(declaration decl,declaration asdecl)
+ | Ast0.Init(stg,ty,id,eq,ini,sem) ->
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
let stg = get_option mcode stg in
- let ty = typeC ty in
+ let ty = typeC allminus ty in
let id = ident id in
let eq = mcode eq in
let ini = initialiser ini in
@@ -479,13 +587,17 @@ and declaration d =
Ast.UnInit(get_option mcode stg,
rewrap ty (do_isos (Ast0.get_iso ty))
(Ast.Type
- (None,
+ (allminus,None,
rewrap ty no_isos
(Ast.FunctionType
- (allminus,get_option typeC tyx,mcode lp1,
+ (allminus,get_option (typeC allminus) tyx,
+ mcode lp1,
parameter_list params,mcode rp1)))),
ident id,mcode sem)
- | _ -> Ast.UnInit(get_option mcode stg,typeC ty,ident id,mcode sem))
+ | _ ->
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
+ Ast.UnInit(get_option mcode stg,typeC allminus ty,ident id,
+ mcode sem))
| Ast0.MacroDecl(name,lp,args,rp,sem) ->
let name = ident name in
let lp = mcode lp in
@@ -493,12 +605,24 @@ and declaration d =
let rp = mcode rp in
let sem = mcode sem in
Ast.MacroDecl(name,lp,args,rp,sem)
- | Ast0.TyDecl(ty,sem) -> Ast.TyDecl(typeC ty,mcode sem)
+ | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
+ let name = ident name in
+ let lp = mcode lp in
+ let args = dots expression args in
+ let rp = mcode rp in
+ let eq = mcode eq in
+ let ini = initialiser ini in
+ let sem = mcode sem in
+ Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem)
+ | Ast0.TyDecl(ty,sem) ->
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
+ Ast.TyDecl(typeC allminus ty,mcode sem)
| Ast0.Typedef(stg,ty,id,sem) ->
- let id = typeC id in
+ let allminus = check_allminus.VT0.combiner_rec_declaration d in
+ let id = typeC allminus id in
(match Ast.unwrap id with
- Ast.Type(None,id) -> (* only MetaType or Id *)
- Ast.Typedef(mcode stg,typeC ty,id,mcode sem)
+ Ast.Type(_,None,id) -> (* only MetaType or Id *)
+ Ast.Typedef(mcode stg,typeC allminus ty,id,mcode sem)
| _ -> failwith "bad typedef")
| Ast0.DisjDecl(_,decls,_,_) -> Ast.DisjDecl(List.map declaration decls)
| Ast0.Ddots(dots,whencode) ->
@@ -514,37 +638,73 @@ and declaration_dots l = dots declaration l
(* Initialiser *)
and strip_idots initlist =
+ let isminus mc =
+ match Ast0.get_mcode_mcodekind mc with
+ Ast0.MINUS _ -> true
+ | _ -> false in
match Ast0.unwrap initlist with
- Ast0.DOTS(x) ->
- let (whencode,init) =
- List.fold_left
- (function (prevwhen,previnit) ->
- function cur ->
- match Ast0.unwrap cur with
+ Ast0.DOTS(l) ->
+ let l =
+ match List.rev l with
+ [] | [_] -> l
+ | x::y::xs ->
+ (match (Ast0.unwrap x,Ast0.unwrap y) with
+ (Ast0.IComma _,Ast0.Idots _) ->
+ (* drop comma that was added by add_comma *)
+ List.rev (y::xs)
+ | _ -> l) in
+ let (whencode,init,dotinfo) =
+ let rec loop = function
+ [] -> ([],[],[])
+ | x::rest ->
+ (match Ast0.unwrap x with
Ast0.Idots(dots,Some whencode) ->
- (whencode :: prevwhen, previnit)
- | Ast0.Idots(dots,None) -> (prevwhen,previnit)
- | _ -> (prevwhen, cur :: previnit))
- ([],[]) x in
- (List.rev whencode, List.rev init)
+ let (restwhen,restinit,dotinfo) = loop rest in
+ (whencode :: restwhen, restinit,
+ (isminus dots)::dotinfo)
+ | Ast0.Idots(dots,None) ->
+ let (restwhen,restinit,dotinfo) = loop rest in
+ (restwhen, restinit, (isminus dots)::dotinfo)
+ | _ ->
+ let (restwhen,restinit,dotinfo) = loop rest in
+ (restwhen,x::restinit,dotinfo)) in
+ loop l in
+ let allminus =
+ if List.for_all (function x -> not x) dotinfo
+ then false (* false if no dots *)
+ else
+ if List.for_all (function x -> x) dotinfo
+ then true
+ else failwith "inconsistent annotations on initialiser list dots" in
+ (whencode, init, allminus)
| Ast0.CIRCLES(x) | Ast0.STARS(x) -> failwith "not possible for an initlist"
and initialiser i =
rewrap i no_isos
(match Ast0.unwrap i with
Ast0.MetaInit(name,_) -> Ast.MetaInit(mcode name,unitary,false)
+ | Ast0.MetaInitList(name,lenname,_) ->
+ Ast.MetaInitList(mcode name,do_lenname lenname,unitary,false)
+ | Ast0.AsInit(init,asinit) ->
+ Ast.AsInit(initialiser init,initialiser asinit)
| Ast0.InitExpr(exp) -> Ast.InitExpr(expression exp)
- | Ast0.InitList(lb,initlist,rb) ->
- let (whencode,initlist) = strip_idots initlist in
- Ast.InitList(mcode lb,List.map initialiser initlist,mcode rb,
- List.map initialiser whencode)
+ | Ast0.InitList(lb,initlist,rb,true) ->
+ Ast.ArInitList(mcode lb,dots initialiser initlist,mcode rb)
+ | Ast0.InitList(lb,initlist,rb,false) ->
+ let (whencode,initlist,allminus) = strip_idots initlist in
+ Ast.StrInitList
+ (allminus,mcode lb,List.map initialiser initlist,mcode rb,
+ List.map initialiser whencode)
| Ast0.InitGccExt(designators,eq,ini) ->
Ast.InitGccExt(List.map designator designators,mcode eq,
initialiser ini)
| Ast0.InitGccName(name,eq,ini) ->
Ast.InitGccName(ident name,mcode eq,initialiser ini)
| Ast0.IComma(comma) -> Ast.IComma(mcode comma)
- | Ast0.Idots(_,_) -> failwith "Idots should have been removed"
+ | Ast0.Idots(dots,whencode) ->
+ let dots = mcode dots in
+ let whencode = get_option initialiser whencode in
+ Ast.Idots(dots,whencode)
| Ast0.OptIni(ini) -> Ast.OptIni(initialiser ini)
| Ast0.UniqueIni(ini) -> Ast.UniqueIni(initialiser ini))
@@ -562,15 +722,14 @@ and designator = function
and parameterTypeDef p =
rewrap p no_isos
(match Ast0.unwrap p with
- Ast0.VoidParam(ty) -> Ast.VoidParam(typeC ty)
- | Ast0.Param(ty,id) -> Ast.Param(typeC ty,get_option ident id)
+ Ast0.VoidParam(ty) -> Ast.VoidParam(typeC false ty)
+ | Ast0.Param(ty,id) ->
+ let allminus = check_allminus.VT0.combiner_rec_parameter p in
+ Ast.Param(typeC allminus ty,get_option ident id)
| Ast0.MetaParam(name,_) ->
Ast.MetaParam(mcode name,unitary,false)
- | Ast0.MetaParamList(name,Some lenname,_) ->
- Ast.MetaParamList(mcode name,Some(mcode lenname,unitary,false),
- unitary,false)
- | Ast0.MetaParamList(name,None,_) ->
- Ast.MetaParamList(mcode name,None,unitary,false)
+ | Ast0.MetaParamList(name,lenname,_) ->
+ Ast.MetaParamList(mcode name,do_lenname lenname,unitary,false)
| Ast0.PComma(cm) -> Ast.PComma(mcode cm)
| Ast0.Pdots(dots) -> Ast.Pdots(mcode dots)
| Ast0.Pcircles(dots) -> Ast.Pcircles(mcode dots)
@@ -598,10 +757,10 @@ and statement s =
rewrap_stmt s
(match Ast0.unwrap s with
Ast0.Decl((_,bef),decl) ->
+ let allminus = check_allminus.VT0.combiner_rec_statement s in
Ast.Atomic(rewrap_rule_elem s
- (Ast.Decl(convert_mcodekind (-1) bef,
- check_allminus.VT0.combiner_rec_statement s,
- declaration decl)))
+ (Ast.Decl(convert_allminus_mcodekind allminus bef,
+ allminus,declaration decl)))
| Ast0.Seq(lbrace,body,rbrace) ->
let lbrace = mcode lbrace in
let body = dots (statement seqible) body in
@@ -612,14 +771,15 @@ and statement s =
tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
| Ast0.ExprStatement(exp,sem) ->
Ast.Atomic(rewrap_rule_elem s
- (Ast.ExprStatement(expression exp,mcode sem)))
- | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
+ (Ast.ExprStatement
+ (get_option expression exp,mcode sem)))
+ | Ast0.IfThen(iff,lp,exp,rp,branch,aft) ->
Ast.IfThen
(rewrap_rule_elem s
(Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)),
statement Ast.NotSequencible branch,
- ([],[],[],convert_mcodekind (-1) aft))
- | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
+ ([],[],[],convert_fake_mcode aft))
+ | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
let els = mcode els in
Ast.IfThenElse
(rewrap_rule_elem s
@@ -627,13 +787,13 @@ and statement s =
statement Ast.NotSequencible branch1,
tokenwrap els s (Ast.Else(els)),
statement Ast.NotSequencible branch2,
- ([],[],[],convert_mcodekind (-1) aft))
- | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
+ ([],[],[],convert_fake_mcode aft))
+ | Ast0.While(wh,lp,exp,rp,body,aft) ->
Ast.While(rewrap_rule_elem s
(Ast.WhileHeader
(mcode wh,mcode lp,expression exp,mcode rp)),
statement Ast.NotSequencible body,
- ([],[],[],convert_mcodekind (-1) aft))
+ ([],[],[],convert_fake_mcode aft))
| Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
let wh = mcode wh in
Ast.Do(rewrap_rule_elem s (Ast.DoHeader(mcode d)),
@@ -641,38 +801,38 @@ and statement s =
tokenwrap wh s
(Ast.WhileTail(wh,mcode lp,expression exp,mcode rp,
mcode sem)))
- | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
+ | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,aft) ->
let fr = mcode fr in
let lp = mcode lp in
- let exp1 = get_option expression exp1 in
- let sem1 = mcode sem1 in
+ let first = forinfo first in
let exp2 = get_option expression exp2 in
let sem2= mcode sem2 in
let exp3 = get_option expression exp3 in
let rp = mcode rp in
let body = statement Ast.NotSequencible body in
Ast.For(rewrap_rule_elem s
- (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp)),
- body,([],[],[],convert_mcodekind (-1) aft))
- | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
+ (Ast.ForHeader(fr,lp,first,exp2,sem2,exp3,rp)),
+ body,([],[],[],convert_fake_mcode aft))
+ | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
Ast.Iterator(rewrap_rule_elem s
(Ast.IteratorHeader
(ident nm,mcode lp,
dots expression args,
mcode rp)),
statement Ast.NotSequencible body,
- ([],[],[],convert_mcodekind (-1) aft))
- | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
+ ([],[],[],convert_fake_mcode aft))
+ | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
let switch = mcode switch in
let lp = mcode lp in
let exp = expression exp in
let rp = mcode rp in
let lb = mcode lb in
+ let decls = dots (statement seqible) decls in
let cases = List.map case_line (Ast0.undots cases) in
let rb = mcode rb in
Ast.Switch(rewrap_rule_elem s (Ast.SwitchHeader(switch,lp,exp,rp)),
tokenwrap lb s (Ast.SeqStart(lb)),
- cases,
+ decls,cases,
tokenwrap rb s (Ast.SeqEnd(rb)))
| Ast0.Break(br,sem) ->
Ast.Atomic(rewrap_rule_elem s (Ast.Break(mcode br,mcode sem)))
@@ -695,6 +855,8 @@ and statement s =
| Ast0.MetaStmtList(name,_) ->
Ast.Atomic(rewrap_rule_elem s
(Ast.MetaStmtList(mcode name,unitary,false)))
+ | Ast0.AsStmt(stmt,asstmt) ->
+ Ast.AsStmt(statement seqible stmt,statement seqible asstmt)
| Ast0.TopExp(exp) ->
Ast.Atomic(rewrap_rule_elem s (Ast.TopExp(expression exp)))
| Ast0.Exp(exp) ->
@@ -702,13 +864,15 @@ and statement s =
| Ast0.TopInit(init) ->
Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init)))
| Ast0.Ty(ty) ->
- Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC ty)))
+ let allminus = check_allminus.VT0.combiner_rec_statement s in
+ Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC allminus ty)))
| Ast0.Disj(_,rule_elem_dots_list,_,_) ->
Ast.Disj(List.map (function x -> statement_dots seqible x)
rule_elem_dots_list)
- | Ast0.Nest(_,rule_elem_dots,_,whn,multi) ->
+ | Ast0.Nest(starter,rule_elem_dots,ender,whn,multi) ->
Ast.Nest
- (statement_dots Ast.Sequencible rule_elem_dots,
+ (mcode starter,statement_dots Ast.Sequencible rule_elem_dots,
+ mcode ender,
List.map
(whencode (statement_dots Ast.Sequencible)
(statement Ast.NotSequencible))
@@ -749,13 +913,16 @@ and statement s =
let rbrace = mcode rbrace in
let allminus = check_allminus.VT0.combiner_rec_statement s in
Ast.FunDecl(rewrap_rule_elem s
- (Ast.FunHeader(convert_mcodekind (-1) bef,
- allminus,fi,name,lp,params,rp)),
+ (Ast.FunHeader
+ (convert_allminus_mcodekind allminus bef,
+ allminus,fi,name,lp,params,rp)),
tokenwrap lbrace s (Ast.SeqStart(lbrace)),
body,
tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
| Ast0.Include(inc,str) ->
Ast.Atomic(rewrap_rule_elem s (Ast.Include(mcode inc,mcode str)))
+ | Ast0.Undef(def,id) ->
+ Ast.Atomic(rewrap_rule_elem s (Ast.Undef(mcode def,ident id)))
| Ast0.Define(def,id,params,body) ->
Ast.Define
(rewrap_rule_elem s
@@ -875,9 +1042,21 @@ and statement s =
statement Ast.Sequencible s
+and forinfo fi =
+ match Ast0.unwrap fi with
+ Ast0.ForExp(exp1,sem1) ->
+ let exp1 = get_option expression exp1 in
+ let sem1 = mcode sem1 in
+ Ast.ForExp(exp1,sem1)
+ | Ast0.ForDecl ((_,bef),decl) ->
+ let allminus =
+ check_allminus.VT0.combiner_rec_declaration decl in
+ Ast.ForDecl (convert_allminus_mcodekind allminus bef,
+ allminus, declaration decl)
+
and fninfo = function
Ast0.FStorage(stg) -> Ast.FStorage(mcode stg)
- | Ast0.FType(ty) -> Ast.FType(typeC ty)
+ | Ast0.FType(ty) -> Ast.FType(typeC false ty)
| Ast0.FInline(inline) -> Ast.FInline(mcode inline)
| Ast0.FAttr(attr) -> Ast.FAttr(mcode attr)
@@ -899,6 +1078,10 @@ and case_line c =
let colon = mcode colon in
let code = dots statement code in
Ast.CaseLine(rewrap c no_isos (Ast.Case(case,exp,colon)),code)
+ | Ast0.DisjCase(_,case_lines,_,_) ->
+ failwith "not supported"
+ (*Ast.CaseLine(Ast.DisjRuleElem(List.map case_line case_lines))*)
+
| Ast0.OptCase(case) -> Ast.OptCase(case_line case))
and statement_dots l = dots statement l
@@ -917,17 +1100,19 @@ and anything = function
| Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d)
| Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
failwith "only in isos, not converted to ast"
- | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC d)
+ | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC false d)
| Ast0.ParamTag(d) -> Ast.ParamTag(parameterTypeDef d)
| Ast0.InitTag(d) -> Ast.InitTag(initialiser d)
| Ast0.DeclTag(d) -> Ast.DeclarationTag(declaration d)
| Ast0.StmtTag(d) -> Ast.StatementTag(statement d)
+ | Ast0.ForInfoTag(d) -> Ast.ForInfoTag(forinfo d)
| Ast0.CaseLineTag(d) -> Ast.CaseLineTag(case_line d)
| Ast0.TopTag(d) -> Ast.Code(top_level d)
| Ast0.IsoWhenTag(_) -> failwith "not possible"
| Ast0.IsoWhenTTag(_) -> failwith "not possible"
| Ast0.IsoWhenFTag(_) -> failwith "not possible"
| Ast0.MetaPosTag _ -> failwith "not possible"
+ | Ast0.HiddenVarTag _ -> failwith "not possible"
(* --------------------------------------------------------------------- *)
(* Function declaration *)
@@ -938,11 +1123,10 @@ and top_level t =
(match Ast0.unwrap t with
Ast0.FILEINFO(old_file,new_file) ->
Ast.FILEINFO(mcode old_file,mcode new_file)
- | Ast0.DECL(stmt) -> Ast.DECL(statement stmt)
- | Ast0.CODE(rule_elem_dots) ->
- Ast.CODE(statement_dots rule_elem_dots)
+ | Ast0.NONDECL(stmt) -> Ast.NONDECL(statement stmt)
+ | Ast0.CODE(rule_elem_dots) -> Ast.CODE(statement_dots rule_elem_dots)
| Ast0.ERRORWORDS(exps) -> Ast.ERRORWORDS(List.map expression exps)
- | Ast0.OTHER(_) -> failwith "eliminated by top_level")
+ | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level")
(* --------------------------------------------------------------------- *)
(* Entry point for minus code *)