HCoop Git - bpt/coccinelle.git/blame_incremental

... / ...

Commit	Line	Data
	1	(*
	2	* Copyright 2012, INRIA
	3	* Julia Lawall, Gilles Muller
	4	* Copyright 2010-2011, INRIA, University of Copenhagen
	5	* Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
	6	* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
	7	* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
	8	* This file is part of Coccinelle.
	9	*
	10	* Coccinelle is free software: you can redistribute it and/or modify
	11	* it under the terms of the GNU General Public License as published by
	12	* the Free Software Foundation, according to version 2 of the License.
	13	*
	14	* Coccinelle is distributed in the hope that it will be useful,
	15	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	* GNU General Public License for more details.
	18	*
	19	* You should have received a copy of the GNU General Public License
	20	* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
	21	*
	22	* The authors reserve the right to distribute this or future versions of
	23	* Coccinelle under other licenses.
	24	*)
	25
	26
	27	# 0 "./parse_cocci.ml"
	28	(* splits the entire file into minus and plus fragments, and parses each
	29	separately (thus duplicating work for the parsing of the context elements) *)
	30
	31	module D = Data
	32	module PC = Parser_cocci_menhir
	33	module V0 = Visitor_ast0
	34	module VT0 = Visitor_ast0_types
	35	module Ast = Ast_cocci
	36	module Ast0 = Ast0_cocci
	37
	38	exception Bad_virt of string
	39
	40	let pr = Printf.sprintf
	41	(let pr2 s = prerr_string s; prerr_string "\n"; flush stderr)
	42	let pr2 s = Printf.printf "%s\n" s
	43
	44	(* for isomorphisms. all should be at the front!!! *)
	45	let reserved_names =
	46	["all";"optional_storage";"optional_qualifier";"value_format";"comm_assoc"]
	47
	48	(* ----------------------------------------------------------------------- *)
	49	(* Debugging... *)
	50
	51	let line_type (d,_,_,_,_,_,_,_) = d
	52
	53	let line_type2c tok =
	54	match line_type tok with
	55	D.MINUS \| D.OPTMINUS \| D.UNIQUEMINUS -> ":-"
	56	\| D.PLUS -> ":+"
	57	\| D.PLUSPLUS -> ":++"
	58	\| D.CONTEXT \| D.UNIQUE \| D.OPT -> ""
	59
	60	let token2c (tok,_) =
	61	match tok with
	62	PC.TMetavariable -> "metavariable"
	63	\| PC.TIdentifier -> "identifier"
	64	\| PC.TType -> "type"
	65	\| PC.TParameter -> "parameter"
	66	\| PC.TConstant -> "constant"
	67	\| PC.TExpression -> "expression"
	68	\| PC.TIdExpression -> "idexpression"
	69	\| PC.TInitialiser -> "initialiser"
	70	\| PC.TSymbol -> "symbol"
	71	\| PC.TDeclaration -> "declaration"
	72	\| PC.TField -> "field"
	73	\| PC.TStatement -> "statement"
	74	\| PC.TPosition -> "position"
	75	\| PC.TPosAny -> "any"
	76	\| PC.TFunction -> "function"
	77	\| PC.TLocal -> "local"
	78	\| PC.Tlist -> "list"
	79	\| PC.TFresh -> "fresh"
	80	\| PC.TCppConcatOp -> "##"
	81	\| PC.TPure -> "pure"
	82	\| PC.TContext -> "context"
	83	\| PC.TTypedef -> "typedef"
	84	\| PC.TDeclarer -> "declarer"
	85	\| PC.TIterator -> "iterator"
	86	\| PC.TName -> "name"
	87	\| PC.TRuleName str -> "rule_name-"^str
	88	\| PC.TUsing -> "using"
	89	\| PC.TVirtual -> "virtual"
	90	\| PC.TPathIsoFile str -> "path_iso_file-"^str
	91	\| PC.TDisable -> "disable"
	92	\| PC.TExtends -> "extends"
	93	\| PC.TDepends -> "depends"
	94	\| PC.TOn -> "on"
	95	\| PC.TEver -> "ever"
	96	\| PC.TNever -> "never"
	97	\| PC.TExists -> "exists"
	98	\| PC.TForall -> "forall"
	99	\| PC.TError -> "error"
	100	\| PC.TWords -> "words"
	101	\| PC.TGenerated -> "generated"
	102
	103	\| PC.TNothing -> "nothing"
	104
	105	\| PC.Tchar(clt) -> "char"^(line_type2c clt)
	106	\| PC.Tshort(clt) -> "short"^(line_type2c clt)
	107	\| PC.Tint(clt) -> "int"^(line_type2c clt)
	108	\| PC.Tdouble(clt) -> "double"^(line_type2c clt)
	109	\| PC.Tfloat(clt) -> "float"^(line_type2c clt)
	110	\| PC.Tlong(clt) -> "long"^(line_type2c clt)
	111	\| PC.Tvoid(clt) -> "void"^(line_type2c clt)
	112	\| PC.Tsize_t(clt) -> "size_t"^(line_type2c clt)
	113	\| PC.Tssize_t(clt) -> "ssize_t"^(line_type2c clt)
	114	\| PC.Tptrdiff_t(clt) -> "ptrdiff_t"^(line_type2c clt)
	115	\| PC.Tstruct(clt) -> "struct"^(line_type2c clt)
	116	\| PC.Tunion(clt) -> "union"^(line_type2c clt)
	117	\| PC.Tenum(clt) -> "enum"^(line_type2c clt)
	118	\| PC.Tunsigned(clt) -> "unsigned"^(line_type2c clt)
	119	\| PC.Tsigned(clt) -> "signed"^(line_type2c clt)
	120	\| PC.Tstatic(clt) -> "static"^(line_type2c clt)
	121	\| PC.Tinline(clt) -> "inline"^(line_type2c clt)
	122	\| PC.Ttypedef(clt) -> "typedef"^(line_type2c clt)
	123	\| PC.Tattr(s,clt) -> s^(line_type2c clt)
	124	\| PC.Tauto(clt) -> "auto"^(line_type2c clt)
	125	\| PC.Tregister(clt) -> "register"^(line_type2c clt)
	126	\| PC.Textern(clt) -> "extern"^(line_type2c clt)
	127	\| PC.Tconst(clt) -> "const"^(line_type2c clt)
	128	\| PC.Tvolatile(clt) -> "volatile"^(line_type2c clt)
	129
	130	\| PC.TPragma(Ast.Noindent s,_) -> s
	131	\| PC.TPragma(Ast.Indent s,_) -> s
	132	\| PC.TPragma(Ast.Space s,_) -> s
	133	\| PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt)
	134	\| PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt)
	135	\| PC.TUndef(clt,_) -> "#undef"^(line_type2c clt)
	136	\| PC.TDefine(clt,_) -> "#define"^(line_type2c clt)
	137	\| PC.TDefineParam(clt,_,_,_) -> "#define_param"^(line_type2c clt)
	138	\| PC.TMinusFile(s,clt) -> (pr "--- %s" s)^(line_type2c clt)
	139	\| PC.TPlusFile(s,clt) -> (pr "+++ %s" s)^(line_type2c clt)
	140
	141	\| PC.TInc(clt) -> "++"^(line_type2c clt)
	142	\| PC.TDec(clt) -> "--"^(line_type2c clt)
	143
	144	\| PC.TIf(clt) -> "if"^(line_type2c clt)
	145	\| PC.TElse(clt) -> "else"^(line_type2c clt)
	146	\| PC.TWhile(clt) -> "while"^(line_type2c clt)
	147	\| PC.TFor(clt) -> "for"^(line_type2c clt)
	148	\| PC.TDo(clt) -> "do"^(line_type2c clt)
	149	\| PC.TSwitch(clt) -> "switch"^(line_type2c clt)
	150	\| PC.TCase(clt) -> "case"^(line_type2c clt)
	151	\| PC.TDefault(clt) -> "default"^(line_type2c clt)
	152	\| PC.TReturn(clt) -> "return"^(line_type2c clt)
	153	\| PC.TBreak(clt) -> "break"^(line_type2c clt)
	154	\| PC.TContinue(clt) -> "continue"^(line_type2c clt)
	155	\| PC.TGoto(clt) -> "goto"^(line_type2c clt)
	156	\| PC.TIdent(s,clt) -> (pr "ident-%s" s)^(line_type2c clt)
	157	\| PC.TTypeId(s,clt) -> (pr "typename-%s" s)^(line_type2c clt)
	158	\| PC.TDeclarerId(s,clt) -> (pr "declarername-%s" s)^(line_type2c clt)
	159	\| PC.TIteratorId(s,clt) -> (pr "iteratorname-%s" s)^(line_type2c clt)
	160	\| PC.TSymId(s,clt) -> (pr "symbol-%s" s)^(line_type2c clt)
	161	\| PC.TMetaDeclarer(_,_,_,clt) -> "declmeta"^(line_type2c clt)
	162	\| PC.TMetaIterator(_,_,_,clt) -> "itermeta"^(line_type2c clt)
	163
	164	\| PC.TSizeof(clt) -> "sizeof"^(line_type2c clt)
	165
	166	\| PC.TString(x,clt) -> x^(line_type2c clt)
	167	\| PC.TChar(x,clt) -> x^(line_type2c clt)
	168	\| PC.TFloat(x,clt) -> x^(line_type2c clt)
	169	\| PC.TInt(x,clt) -> x^(line_type2c clt)
	170
	171	\| PC.TOrLog(clt) -> "\|\|"^(line_type2c clt)
	172	\| PC.TAndLog(clt) -> "&&"^(line_type2c clt)
	173	\| PC.TOr(clt) -> "\|"^(line_type2c clt)
	174	\| PC.TXor(clt) -> "^"^(line_type2c clt)
	175	\| PC.TAnd (clt) -> "&"^(line_type2c clt)
	176	\| PC.TEqEq(clt) -> "=="^(line_type2c clt)
	177	\| PC.TNotEq(clt) -> "!="^(line_type2c clt)
	178	\| PC.TSub(clt) -> "<="^(line_type2c clt)
	179	\| PC.TTildeEq(clt) -> "~="^(line_type2c clt)
	180	\| PC.TTildeExclEq(clt) -> "~!="^(line_type2c clt)
	181	\| PC.TLogOp(op,clt) ->
	182	(match op with
	183	Ast.Inf -> "<"
	184	\| Ast.InfEq -> "<="
	185	\| Ast.Sup -> ">"
	186	\| Ast.SupEq -> ">="
	187	\| _ -> failwith "not possible")
	188	^(line_type2c clt)
	189	\| PC.TShLOp(op,clt) -> "<<"^(line_type2c clt)
	190	\| PC.TShROp(op,clt) -> ">>"^(line_type2c clt)
	191	\| PC.TPlus(clt) -> "+"^(line_type2c clt)
	192	\| PC.TMinus(clt) -> "-"^(line_type2c clt)
	193	\| PC.TMul(clt) -> "*"^(line_type2c clt)
	194	\| PC.TDmOp(op,clt) ->
	195	(match op with
	196	Ast.Div -> "/"
	197	\| Ast.Mod -> "%"
	198	\| _ -> failwith "not possible")
	199	^(line_type2c clt)
	200	\| PC.TTilde (clt) -> "~"^(line_type2c clt)
	201
	202	\| PC.TMeta(_,_,clt) -> "meta"^(line_type2c clt)
	203	\| PC.TMetaParam(_,_,clt) -> "parammeta"^(line_type2c clt)
	204	\| PC.TMetaParamList(_,_,_,clt) -> "paramlistmeta"^(line_type2c clt)
	205	\| PC.TMetaConst(_,_,_,_,clt) -> "constmeta"^(line_type2c clt)
	206	\| PC.TMetaErr(_,_,_,clt) -> "errmeta"^(line_type2c clt)
	207	\| PC.TMetaExp(_,_,_,_,clt) -> "expmeta"^(line_type2c clt)
	208	\| PC.TMetaIdExp(_,_,_,_,clt) -> "idexpmeta"^(line_type2c clt)
	209	\| PC.TMetaLocalIdExp(_,_,_,_,clt) -> "localidexpmeta"^(line_type2c clt)
	210	\| PC.TMetaExpList(_,_,_,clt) -> "explistmeta"^(line_type2c clt)
	211	\| PC.TMetaId(nm,_,_,_,clt) -> "idmeta-"^(Dumper.dump nm)^(line_type2c clt)
	212	\| PC.TMetaType(_,_,clt) -> "typemeta"^(line_type2c clt)
	213	\| PC.TMetaInit(_,_,clt) -> "initmeta"^(line_type2c clt)
	214	\| PC.TMetaInitList(_,_,_,clt) -> "initlistmeta"^(line_type2c clt)
	215	\| PC.TMetaDecl(_,_,clt) -> "declmeta"^(line_type2c clt)
	216	\| PC.TMetaField(_,_,clt) -> "fieldmeta"^(line_type2c clt)
	217	\| PC.TMetaFieldList(_,_,_,clt) -> "fieldlistmeta"^(line_type2c clt)
	218	\| PC.TMetaStm(_,_,clt) -> "stmmeta"^(line_type2c clt)
	219	\| PC.TMetaStmList(_,_,clt) -> "stmlistmeta"^(line_type2c clt)
	220	\| PC.TMetaFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt)
	221	\| PC.TMetaLocalFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt)
	222	\| PC.TMetaPos(_,_,_,clt) -> "posmeta"
	223	\| PC.TMPtVirg -> ";"
	224	\| PC.TArobArob -> "@@"
	225	\| PC.TArob -> "@"
	226	\| PC.TPArob clt -> "P@"
	227	\| PC.TScript -> "script"
	228	\| PC.TInitialize -> "initialize"
	229	\| PC.TFinalize -> "finalize"
	230
	231	\| PC.TWhen(clt) -> "WHEN"^(line_type2c clt)
	232	\| PC.TWhenTrue(clt) -> "WHEN TRUE"^(line_type2c clt)
	233	\| PC.TWhenFalse(clt) -> "WHEN FALSE"^(line_type2c clt)
	234	\| PC.TAny(clt) -> "ANY"^(line_type2c clt)
	235	\| PC.TStrict(clt) -> "STRICT"^(line_type2c clt)
	236	\| PC.TEllipsis(clt) -> "..."^(line_type2c clt)
	237	(*
	238	\| PC.TCircles(clt) -> "ooo"^(line_type2c clt)
	239	\| PC.TStars(clt) -> "***"^(line_type2c clt)
	240	*)
	241
	242	\| PC.TOEllipsis(clt) -> "<..."^(line_type2c clt)
	243	\| PC.TCEllipsis(clt) -> "...>"^(line_type2c clt)
	244	\| PC.TPOEllipsis(clt) -> "<+..."^(line_type2c clt)
	245	\| PC.TPCEllipsis(clt) -> "...+>"^(line_type2c clt)
	246	(*
	247	\| PC.TOCircles(clt) -> "<ooo"^(line_type2c clt)
	248	\| PC.TCCircles(clt) -> "ooo>"^(line_type2c clt)
	249	\| PC.TOStars(clt) -> "<***"^(line_type2c clt)
	250	\| PC.TCStars(clt) -> "***>"^(line_type2c clt)
	251	*)
	252	\| PC.TBang0 -> "!"
	253	\| PC.TPlus0 -> "+"
	254	\| PC.TWhy0 -> "?"
	255
	256	\| PC.TWhy(clt) -> "?"^(line_type2c clt)
	257	\| PC.TDotDot(clt) -> ":"^(line_type2c clt)
	258	\| PC.TBang(clt) -> "!"^(line_type2c clt)
	259	\| PC.TOPar(clt) -> "("^(line_type2c clt)
	260	\| PC.TOPar0(clt) -> "("^(line_type2c clt)
	261	\| PC.TMid0(clt) -> "\|"^(line_type2c clt)
	262	\| PC.TCPar(clt) -> ")"^(line_type2c clt)
	263	\| PC.TCPar0(clt) -> ")"^(line_type2c clt)
	264
	265	\| PC.TOBrace(clt) -> "{"^(line_type2c clt)
	266	\| PC.TCBrace(clt) -> "}"^(line_type2c clt)
	267	\| PC.TOCro(clt) -> "["^(line_type2c clt)
	268	\| PC.TCCro(clt) -> "]"^(line_type2c clt)
	269	\| PC.TOInit(clt) -> "{"^(line_type2c clt)
	270
	271	\| PC.TPtrOp(clt) -> "->"^(line_type2c clt)
	272
	273	\| PC.TEq(clt) -> "="^(line_type2c clt)
	274	\| PC.TAssign(_,clt) -> "=op"^(line_type2c clt)
	275	\| PC.TDot(clt) -> "."^(line_type2c clt)
	276	\| PC.TComma(clt) -> ","^(line_type2c clt)
	277	\| PC.TPtVirg(clt) -> ";"^(line_type2c clt)
	278
	279	\| PC.EOF -> "eof"
	280	\| PC.TLineEnd(clt) -> "line end"
	281	\| PC.TInvalid -> "invalid"
	282	\| PC.TFunDecl(clt) -> "fundecl"
	283
	284	\| PC.TIso -> "<=>"
	285	\| PC.TRightIso -> "=>"
	286	\| PC.TIsoTopLevel -> "TopLevel"
	287	\| PC.TIsoExpression -> "Expression"
	288	\| PC.TIsoArgExpression -> "ArgExpression"
	289	\| PC.TIsoTestExpression -> "TestExpression"
	290	\| PC.TIsoToTestExpression -> "ToTestExpression"
	291	\| PC.TIsoStatement -> "Statement"
	292	\| PC.TIsoDeclaration -> "Declaration"
	293	\| PC.TIsoType -> "Type"
	294	\| PC.TUnderscore -> "_"
	295	\| PC.TScriptData s -> s
	296
	297	let print_tokens s tokens =
	298	Printf.printf "%s\n" s;
	299	List.iter (function x -> Printf.printf "\|%s\| " (token2c x)) tokens;
	300	Printf.printf "\n\n";
	301	flush stdout
	302
	303	type plus = PLUS \| NOTPLUS \| SKIP
	304
	305	let plus_attachable only_plus (tok,_) =
	306	match tok with
	307	PC.Tchar(clt) \| PC.Tshort(clt) \| PC.Tint(clt) \| PC.Tdouble(clt)
	308	\| PC.Tfloat(clt) \| PC.Tlong(clt)
	309	\| PC.Tsize_t(clt) \| PC.Tssize_t(clt) \| PC.Tptrdiff_t(clt)
	310	\| PC.Tstruct(clt)
	311	\| PC.Tunion(clt) \| PC.Tenum(clt) \| PC.Tunsigned(clt) \| PC.Tsigned(clt)
	312	\| PC.Tstatic(clt)
	313	\| PC.Tinline(clt) \| PC.Ttypedef(clt) \| PC.Tattr(_,clt)
	314	\| PC.Tauto(clt) \| PC.Tregister(clt)
	315	\| PC.Textern(clt) \| PC.Tconst(clt) \| PC.Tvolatile(clt)
	316
	317	\| PC.TIncludeL(_,clt) \| PC.TIncludeNL(_,clt) \| PC.TUndef(clt,_)
	318	\| PC.TDefine(clt,_)
	319	\| PC.TDefineParam(clt,_,_,_) \| PC.TMinusFile(_,clt) \| PC.TPlusFile(_,clt)
	320
	321	\| PC.TInc(clt) \| PC.TDec(clt)
	322
	323	\| PC.TIf(clt) \| PC.TElse(clt) \| PC.TWhile(clt) \| PC.TFor(clt) \| PC.TDo(clt)
	324	\| PC.TSwitch(clt) \| PC.TCase(clt) \| PC.TDefault(clt) \| PC.TReturn(clt)
	325	\| PC.TBreak(clt) \| PC.TContinue(clt) \| PC.TGoto(clt) \| PC.TIdent(_,clt)
	326	\| PC.TTypeId(_,clt) \| PC.TDeclarerId(_,clt) \| PC.TIteratorId(_,clt)
	327
	328	\| PC.TSizeof(clt)
	329
	330	\| PC.TString(_,clt) \| PC.TChar(_,clt) \| PC.TFloat(_,clt) \| PC.TInt(_,clt)
	331
	332	\| PC.TOrLog(clt) \| PC.TAndLog(clt) \| PC.TOr(clt) \| PC.TXor(clt)
	333	\| PC.TAnd (clt) \| PC.TEqEq(clt) \| PC.TNotEq(clt) \| PC.TTildeEq(clt)
	334	\| PC.TLogOp(_,clt)
	335	\| PC.TShLOp(_,clt) \| PC.TShROp(_,clt)
	336	\| PC.TPlus(clt) \| PC.TMinus(clt) \| PC.TMul(clt)
	337	\| PC.TDmOp(_,clt) \| PC.TTilde (clt)
	338
	339	\| PC.TMeta(_,_,clt) \| PC.TMetaParam(_,_,clt) \| PC.TMetaParamList(_,_,_,clt)
	340	\| PC.TMetaConst(_,_,_,_,clt) \| PC.TMetaErr(_,_,_,clt)
	341	\| PC.TMetaExp(_,_,_,_,clt) \| PC.TMetaIdExp(_,_,_,_,clt)
	342	\| PC.TMetaLocalIdExp(_,_,_,_,clt)
	343	\| PC.TMetaExpList(_,_,_,clt)
	344	\| PC.TMetaId(_,_,_,_,clt)
	345	\| PC.TMetaType(_,_,clt) \| PC.TMetaInit(_,_,clt) \| PC.TMetaInitList(_,_,_,clt)
	346	\| PC.TMetaStm(_,_,clt)
	347	\| PC.TMetaStmList(_,_,clt)
	348	\| PC.TMetaDecl(_,_,clt) \| PC.TMetaField(_,_,clt)
	349	\| PC.TMetaFieldList(_,_,_,clt)
	350	\| PC.TMetaFunc(_,_,_,clt) \| PC.TMetaLocalFunc(_,_,_,clt)
	351
	352	\| PC.TWhen(clt) \| PC.TWhenTrue(clt) \| PC.TWhenFalse(clt)
	353	\| PC.TAny(clt) \| PC.TStrict(clt) \| PC.TEllipsis(clt)
	354	(* \| PC.TCircles(clt) \| PC.TStars(clt) *)
	355	\| PC.TOEllipsis(clt) \| PC.TCEllipsis(clt)
	356	\| PC.TPOEllipsis(clt) \| PC.TPCEllipsis(clt) (* \| PC.TOCircles(clt)
	357	\| PC.TCCircles(clt) \| PC.TOStars(clt) \| PC.TCStars(clt) *)
	358
	359	\| PC.TWhy(clt) \| PC.TDotDot(clt) \| PC.TBang(clt) \| PC.TOPar(clt)
	360	\| PC.TCPar(clt)
	361
	362	\| PC.TOBrace(clt) \| PC.TCBrace(clt) \| PC.TOCro(clt) \| PC.TCCro(clt)
	363	\| PC.TOInit(clt)
	364
	365	\| PC.TPtrOp(clt)
	366
	367	\| PC.TEq(clt) \| PC.TAssign(_,clt) \| PC.TDot(clt) \| PC.TComma(clt)
	368	\| PC.TPtVirg(clt) ->
	369	if List.mem (line_type clt) [D.PLUS;D.PLUSPLUS]
	370	then PLUS
	371	else if only_plus then NOTPLUS
	372	else if line_type clt = D.CONTEXT then PLUS else NOTPLUS
	373
	374	\| PC.TOPar0(clt) \| PC.TMid0(clt) \| PC.TCPar0(clt) -> NOTPLUS
	375	\| PC.TMetaPos(nm,_,_,_) -> NOTPLUS
	376	\| PC.TSub(clt) -> NOTPLUS
	377
	378	\| _ -> SKIP
	379
	380	let get_clt (tok,_) =
	381	match tok with
	382	PC.Tchar(clt) \| PC.Tshort(clt) \| PC.Tint(clt) \| PC.Tdouble(clt)
	383	\| PC.Tfloat(clt) \| PC.Tlong(clt) \| PC.Tvoid(clt)
	384	\| PC.Tsize_t(clt) \| PC.Tssize_t(clt) \| PC.Tptrdiff_t(clt)
	385	\| PC.Tstruct(clt)
	386	\| PC.Tunion(clt) \| PC.Tenum(clt) \| PC.Tunsigned(clt) \| PC.Tsigned(clt)
	387	\| PC.Tstatic(clt)
	388	\| PC.Tinline(clt) \| PC.Tattr(_,clt) \| PC.Tauto(clt) \| PC.Tregister(clt)
	389	\| PC.Textern(clt) \| PC.Tconst(clt) \| PC.Tvolatile(clt)
	390
	391	\| PC.TIncludeL(_,clt) \| PC.TIncludeNL(_,clt) \| PC.TUndef(clt,_)
	392	\| PC.TDefine(clt,_)
	393	\| PC.TDefineParam(clt,_,_,_) \| PC.TMinusFile(_,clt) \| PC.TPlusFile(_,clt)
	394
	395	\| PC.TInc(clt) \| PC.TDec(clt)
	396
	397	\| PC.TIf(clt) \| PC.TElse(clt) \| PC.TWhile(clt) \| PC.TFor(clt) \| PC.TDo(clt)
	398	\| PC.TSwitch(clt) \| PC.TCase(clt) \| PC.TDefault(clt) \| PC.TReturn(clt)
	399	\| PC.TBreak(clt) \| PC.TContinue(clt) \| PC.TGoto(clt) \| PC.TIdent(_,clt)
	400	\| PC.TTypeId(_,clt) \| PC.TSymId(_,clt)
	401	\| PC.TDeclarerId(_,clt) \| PC.TIteratorId(_,clt)
	402
	403	\| PC.TSizeof(clt)
	404
	405	\| PC.TString(_,clt) \| PC.TChar(_,clt) \| PC.TFloat(_,clt) \| PC.TInt(_,clt)
	406
	407	\| PC.TOrLog(clt) \| PC.TAndLog(clt) \| PC.TOr(clt) \| PC.TXor(clt)
	408	\| PC.TAnd (clt) \| PC.TEqEq(clt) \| PC.TNotEq(clt) \| PC.TTildeEq(clt)
	409	\| PC.TSub(clt) \| PC.TLogOp(_,clt)
	410	\| PC.TShLOp(_,clt) \| PC.TShROp(_,clt)
	411	\| PC.TPlus(clt) \| PC.TMinus(clt) \| PC.TMul(clt)
	412	\| PC.TDmOp(_,clt) \| PC.TTilde (clt)
	413
	414	\| PC.TMeta(_,_,clt) \| PC.TMetaParam(_,_,clt) \| PC.TMetaParamList(_,_,_,clt)
	415	\| PC.TMetaConst(_,_,_,_,clt) \| PC.TMetaErr(_,_,_,clt)
	416	\| PC.TMetaExp(_,_,_,_,clt) \| PC.TMetaIdExp(_,_,_,_,clt)
	417	\| PC.TMetaLocalIdExp(_,_,_,_,clt)
	418	\| PC.TMetaExpList(_,_,_,clt)
	419	\| PC.TMetaId(_,_,_,_,clt)
	420	\| PC.TMetaType(_,_,clt) \| PC.TMetaInit(_,_,clt) \| PC.TMetaInitList(_,_,_,clt)
	421	\| PC.TMetaStm(_,_,clt)
	422	\| PC.TMetaStmList(_,_,clt)
	423	\| PC.TMetaDecl(_,_,clt) \| PC.TMetaField(_,_,clt)
	424	\| PC.TMetaFieldList(_,_,_,clt)
	425	\| PC.TMetaFunc(_,_,_,clt) \| PC.TMetaLocalFunc(_,_,_,clt)
	426	\| PC.TMetaPos(_,_,_,clt)
	427	\| PC.TMetaDeclarer(_,_,_,clt) \| PC.TMetaIterator(_,_,_,clt)
	428
	429	\| PC.TWhen(clt) \| PC.TWhenTrue(clt) \| PC.TWhenFalse(clt) \|
	430	PC.TAny(clt) \| PC.TStrict(clt) \| PC.TEllipsis(clt)
	431	(* \| PC.TCircles(clt) \| PC.TStars(clt) *)
	432
	433	\| PC.TWhy(clt) \| PC.TDotDot(clt) \| PC.TBang(clt) \| PC.TOPar(clt)
	434	\| PC.TCPar(clt)
	435
	436	\| PC.TOBrace(clt) \| PC.TCBrace(clt) \| PC.TOCro(clt) \| PC.TCCro(clt)
	437	\| PC.TOInit(clt)
	438
	439	\| PC.TPtrOp(clt)
	440
	441	\| PC.TEq(clt) \| PC.TAssign(_,clt) \| PC.TDot(clt) \| PC.TComma(clt)
	442	\| PC.TPArob(clt) \| PC.TPtVirg(clt)
	443
	444	\| PC.TOPar0(clt) \| PC.TMid0(clt) \| PC.TCPar0(clt)
	445	\| PC.TOEllipsis(clt) \| PC.TCEllipsis(clt)
	446	\| PC.TPOEllipsis(clt) \| PC.TPCEllipsis(clt) (* \| PC.TOCircles(clt)
	447	\| PC.TCCircles(clt) \| PC.TOStars(clt) \| PC.TCStars(clt) *) -> clt
	448
	449	\| _ -> failwith "no clt"
	450
	451	let update_clt (tok,x) clt =
	452	match tok with
	453	PC.Tchar(_) -> (PC.Tchar(clt),x)
	454	\| PC.Tshort(_) -> (PC.Tshort(clt),x)
	455	\| PC.Tint(_) -> (PC.Tint(clt),x)
	456	\| PC.Tdouble(_) -> (PC.Tdouble(clt),x)
	457	\| PC.Tfloat(_) -> (PC.Tfloat(clt),x)
	458	\| PC.Tlong(_) -> (PC.Tlong(clt),x)
	459	\| PC.Tvoid(_) -> (PC.Tvoid(clt),x)
	460	\| PC.Tsize_t(_) -> (PC.Tsize_t(clt),x)
	461	\| PC.Tssize_t(_) -> (PC.Tssize_t(clt),x)
	462	\| PC.Tptrdiff_t(_) -> (PC.Tptrdiff_t(clt),x)
	463	\| PC.Tstruct(_) -> (PC.Tstruct(clt),x)
	464	\| PC.Tunion(_) -> (PC.Tunion(clt),x)
	465	\| PC.Tenum(_) -> (PC.Tenum(clt),x)
	466	\| PC.Tunsigned(_) -> (PC.Tunsigned(clt),x)
	467	\| PC.Tsigned(_) -> (PC.Tsigned(clt),x)
	468	\| PC.Tstatic(_) -> (PC.Tstatic(clt),x)
	469	\| PC.Tinline(_) -> (PC.Tinline(clt),x)
	470	\| PC.Ttypedef(_) -> (PC.Ttypedef(clt),x)
	471	\| PC.Tattr(s,_) -> (PC.Tattr(s,clt),x)
	472	\| PC.Tauto(_) -> (PC.Tauto(clt),x)
	473	\| PC.Tregister(_) -> (PC.Tregister(clt),x)
	474	\| PC.Textern(_) -> (PC.Textern(clt),x)
	475	\| PC.Tconst(_) -> (PC.Tconst(clt),x)
	476	\| PC.Tvolatile(_) -> (PC.Tvolatile(clt),x)
	477
	478	\| PC.TIncludeL(s,_) -> (PC.TIncludeL(s,clt),x)
	479	\| PC.TIncludeNL(s,_) -> (PC.TIncludeNL(s,clt),x)
	480	\| PC.TUndef(_,a) -> (PC.TUndef(clt,a),x)
	481	\| PC.TDefine(_,a) -> (PC.TDefine(clt,a),x)
	482	\| PC.TDefineParam(_,a,b,c) -> (PC.TDefineParam(clt,a,b,c),x)
	483	\| PC.TMinusFile(s,_) -> (PC.TMinusFile(s,clt),x)
	484	\| PC.TPlusFile(s,_) -> (PC.TPlusFile(s,clt),x)
	485
	486	\| PC.TInc(_) -> (PC.TInc(clt),x)
	487	\| PC.TDec(_) -> (PC.TDec(clt),x)
	488
	489	\| PC.TIf(_) -> (PC.TIf(clt),x)
	490	\| PC.TElse(_) -> (PC.TElse(clt),x)
	491	\| PC.TWhile(_) -> (PC.TWhile(clt),x)
	492	\| PC.TFor(_) -> (PC.TFor(clt),x)
	493	\| PC.TDo(_) -> (PC.TDo(clt),x)
	494	\| PC.TSwitch(_) -> (PC.TSwitch(clt),x)
	495	\| PC.TCase(_) -> (PC.TCase(clt),x)
	496	\| PC.TDefault(_) -> (PC.TDefault(clt),x)
	497	\| PC.TReturn(_) -> (PC.TReturn(clt),x)
	498	\| PC.TBreak(_) -> (PC.TBreak(clt),x)
	499	\| PC.TContinue(_) -> (PC.TContinue(clt),x)
	500	\| PC.TGoto(_) -> (PC.TGoto(clt),x)
	501	\| PC.TIdent(s,_) -> (PC.TIdent(s,clt),x)
	502	\| PC.TTypeId(s,_) -> (PC.TTypeId(s,clt),x)
	503	\| PC.TDeclarerId(s,_) -> (PC.TDeclarerId(s,clt),x)
	504	\| PC.TIteratorId(s,_) -> (PC.TIteratorId(s,clt),x)
	505	\| PC.TSymId(a,_) -> (PC.TSymId(a,clt),x)
	506
	507	\| PC.TSizeof(_) -> (PC.TSizeof(clt),x)
	508
	509	\| PC.TString(s,_) -> (PC.TString(s,clt),x)
	510	\| PC.TChar(s,_) -> (PC.TChar(s,clt),x)
	511	\| PC.TFloat(s,_) -> (PC.TFloat(s,clt),x)
	512	\| PC.TInt(s,_) -> (PC.TInt(s,clt),x)
	513
	514	\| PC.TOrLog(_) -> (PC.TOrLog(clt),x)
	515	\| PC.TAndLog(_) -> (PC.TAndLog(clt),x)
	516	\| PC.TOr(_) -> (PC.TOr(clt),x)
	517	\| PC.TXor(_) -> (PC.TXor(clt),x)
	518	\| PC.TAnd (_) -> (PC.TAnd (clt),x)
	519	\| PC.TEqEq(_) -> (PC.TEqEq(clt),x)
	520	\| PC.TNotEq(_) -> (PC.TNotEq(clt),x)
	521	\| PC.TTildeEq(_) -> (PC.TTildeEq(clt),x)
	522	\| PC.TSub(_) -> (PC.TSub(clt),x)
	523	\| PC.TLogOp(op,_) -> (PC.TLogOp(op,clt),x)
	524	\| PC.TShLOp(op,_) -> (PC.TShLOp(op,clt),x)
	525	\| PC.TShROp(op,_) -> (PC.TShROp(op,clt),x)
	526	\| PC.TPlus(_) -> (PC.TPlus(clt),x)
	527	\| PC.TMinus(_) -> (PC.TMinus(clt),x)
	528	\| PC.TMul(_) -> (PC.TMul(clt),x)
	529	\| PC.TDmOp(op,_) -> (PC.TDmOp(op,clt),x)
	530	\| PC.TTilde (_) -> (PC.TTilde (clt),x)
	531
	532	\| PC.TMeta(a,b,_) -> (PC.TMeta(a,b,clt),x)
	533	\| PC.TMetaParam(a,b,_) -> (PC.TMetaParam(a,b,clt),x)
	534	\| PC.TMetaParamList(a,b,c,_) -> (PC.TMetaParamList(a,b,c,clt),x)
	535	\| PC.TMetaConst(a,b,c,d,_) -> (PC.TMetaConst(a,b,c,d,clt),x)
	536	\| PC.TMetaErr(a,b,c,_) -> (PC.TMetaErr(a,b,c,clt),x)
	537	\| PC.TMetaExp(a,b,c,d,_) -> (PC.TMetaExp(a,b,c,d,clt),x)
	538	\| PC.TMetaIdExp(a,b,c,d,_) -> (PC.TMetaIdExp(a,b,c,d,clt),x)
	539	\| PC.TMetaLocalIdExp(a,b,c,d,_) -> (PC.TMetaLocalIdExp(a,b,c,d,clt),x)
	540	\| PC.TMetaExpList(a,b,c,_) -> (PC.TMetaExpList(a,b,c,clt),x)
	541	\| PC.TMetaId(a,b,c,d,_) -> (PC.TMetaId(a,b,c,d,clt),x)
	542	\| PC.TMetaType(a,b,_) -> (PC.TMetaType(a,b,clt),x)
	543	\| PC.TMetaInit(a,b,_) -> (PC.TMetaInit(a,b,clt),x)
	544	\| PC.TMetaInitList(a,b,c,_) -> (PC.TMetaInitList(a,b,c,clt),x)
	545	\| PC.TMetaDecl(a,b,_) -> (PC.TMetaDecl(a,b,clt),x)
	546	\| PC.TMetaField(a,b,_) -> (PC.TMetaField(a,b,clt),x)
	547	\| PC.TMetaFieldList(a,b,c,_) -> (PC.TMetaFieldList(a,b,c,clt),x)
	548	\| PC.TMetaStm(a,b,_) -> (PC.TMetaStm(a,b,clt),x)
	549	\| PC.TMetaStmList(a,b,_) -> (PC.TMetaStmList(a,b,clt),x)
	550	\| PC.TMetaFunc(a,b,c,_) -> (PC.TMetaFunc(a,b,c,clt),x)
	551	\| PC.TMetaLocalFunc(a,b,c,_) -> (PC.TMetaLocalFunc(a,b,c,clt),x)
	552
	553	\| PC.TMetaDeclarer(a,b,c,_) -> (PC.TMetaDeclarer(a,b,c,clt),x)
	554	\| PC.TMetaIterator(a,b,c,_) -> (PC.TMetaIterator(a,b,c,clt),x)
	555
	556	\| PC.TWhen(_) -> (PC.TWhen(clt),x)
	557	\| PC.TWhenTrue(_) -> (PC.TWhenTrue(clt),x)
	558	\| PC.TWhenFalse(_) -> (PC.TWhenFalse(clt),x)
	559	\| PC.TAny(_) -> (PC.TAny(clt),x)
	560	\| PC.TStrict(_) -> (PC.TStrict(clt),x)
	561	\| PC.TEllipsis(_) -> (PC.TEllipsis(clt),x)
	562	(*
	563	\| PC.TCircles(_) -> (PC.TCircles(clt),x)
	564	\| PC.TStars(_) -> (PC.TStars(clt),x)
	565	*)
	566
	567	\| PC.TOEllipsis(_) -> (PC.TOEllipsis(clt),x)
	568	\| PC.TCEllipsis(_) -> (PC.TCEllipsis(clt),x)
	569	\| PC.TPOEllipsis(_) -> (PC.TPOEllipsis(clt),x)
	570	\| PC.TPCEllipsis(_) -> (PC.TPCEllipsis(clt),x)
	571	(*
	572	\| PC.TOCircles(_) -> (PC.TOCircles(clt),x)
	573	\| PC.TCCircles(_) -> (PC.TCCircles(clt),x)
	574	\| PC.TOStars(_) -> (PC.TOStars(clt),x)
	575	\| PC.TCStars(_) -> (PC.TCStars(clt),x)
	576	*)
	577
	578	\| PC.TWhy(_) -> (PC.TWhy(clt),x)
	579	\| PC.TDotDot(_) -> (PC.TDotDot(clt),x)
	580	\| PC.TBang(_) -> (PC.TBang(clt),x)
	581	\| PC.TOPar(_) -> (PC.TOPar(clt),x)
	582	\| PC.TOPar0(_) -> (PC.TOPar0(clt),x)
	583	\| PC.TMid0(_) -> (PC.TMid0(clt),x)
	584	\| PC.TCPar(_) -> (PC.TCPar(clt),x)
	585	\| PC.TCPar0(_) -> (PC.TCPar0(clt),x)
	586
	587	\| PC.TOBrace(_) -> (PC.TOBrace(clt),x)
	588	\| PC.TCBrace(_) -> (PC.TCBrace(clt),x)
	589	\| PC.TOCro(_) -> (PC.TOCro(clt),x)
	590	\| PC.TCCro(_) -> (PC.TCCro(clt),x)
	591	\| PC.TOInit(_) -> (PC.TOInit(clt),x)
	592
	593	\| PC.TPtrOp(_) -> (PC.TPtrOp(clt),x)
	594
	595	\| PC.TEq(_) -> (PC.TEq(clt),x)
	596	\| PC.TAssign(s,_) -> (PC.TAssign(s,clt),x)
	597	\| PC.TDot(_) -> (PC.TDot(clt),x)
	598	\| PC.TComma(_) -> (PC.TComma(clt),x)
	599	\| PC.TPArob(_) -> (PC.TPArob(clt),x)
	600	\| PC.TPtVirg(_) -> (PC.TPtVirg(clt),x)
	601
	602	\| PC.TLineEnd(_) -> (PC.TLineEnd(clt),x)
	603	\| PC.TFunDecl(_) -> (PC.TFunDecl(clt),x)
	604
	605	\| _ -> failwith "no clt"
	606
	607
	608	(* ----------------------------------------------------------------------- *)
	609
	610	let make_name prefix ln = Printf.sprintf "%s starting on line %d" prefix ln
	611
	612	(* ----------------------------------------------------------------------- *)
	613	(* Read tokens *)
	614
	615	let wrap_lexbuf_info lexbuf =
	616	(Lexing.lexeme lexbuf, Lexing.lexeme_start lexbuf)
	617
	618	let tokens_all_full token table file get_ats lexbuf end_markers :
	619	(bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
	620	try
	621	let rec aux () =
	622	let result = token lexbuf in
	623	let info = (Lexing.lexeme lexbuf,
	624	(table.(Lexing.lexeme_start lexbuf)),
	625	(Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) in
	626	if result = PC.EOF
	627	then
	628	if get_ats
	629	then failwith "unexpected end of file in a metavariable declaration"
	630	else (false,[(result,info)])
	631	else if List.mem result end_markers
	632	then (true,[(result,info)])
	633	else
	634	let (more,rest) = aux() in
	635	(more,(result, info)::rest)
	636	in aux ()
	637	with
	638	e -> pr2 (Common.error_message file (wrap_lexbuf_info lexbuf) ); raise e
	639
	640	let tokens_all table file get_ats lexbuf end_markers :
	641	(bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
	642	tokens_all_full Lexer_cocci.token table file get_ats lexbuf end_markers
	643
	644	let tokens_script_all table file get_ats lexbuf end_markers :
	645	(bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
	646	tokens_all_full Lexer_script.token table file get_ats lexbuf end_markers
	647
	648	(* ----------------------------------------------------------------------- *)
	649	(* Split tokens into minus and plus fragments *)
	650
	651	let split t clt =
	652	let (d,_,_,_,_,_,_,_) = clt in
	653	match d with
	654	D.MINUS \| D.OPTMINUS \| D.UNIQUEMINUS -> ([t],[])
	655	\| D.PLUS \| D.PLUSPLUS -> ([],[t])
	656	\| D.CONTEXT \| D.UNIQUE \| D.OPT -> ([t],[t])
	657
	658	let split_token ((tok,_) as t) =
	659	match tok with
	660	PC.TMetavariable \| PC.TIdentifier
	661	\| PC.TConstant \| PC.TExpression \| PC.TIdExpression
	662	\| PC.TDeclaration \| PC.TField
	663	\| PC.TStatement \| PC.TPosition \| PC.TPosAny \| PC.TInitialiser \| PC.TSymbol
	664	\| PC.TFunction \| PC.TTypedef \| PC.TDeclarer \| PC.TIterator \| PC.TName
	665	\| PC.TType \| PC.TParameter \| PC.TLocal \| PC.Tlist \| PC.TFresh
	666	\| PC.TCppConcatOp \| PC.TPure
	667	\| PC.TContext \| PC.TRuleName(_) \| PC.TUsing \| PC.TVirtual \| PC.TDisable
	668	\| PC.TExtends \| PC.TPathIsoFile(_)
	669	\| PC.TDepends \| PC.TOn \| PC.TEver \| PC.TNever \| PC.TExists \| PC.TForall
	670	\| PC.TError \| PC.TWords \| PC.TGenerated \| PC.TNothing -> ([t],[t])
	671
	672	\| PC.Tchar(clt) \| PC.Tshort(clt) \| PC.Tint(clt) \| PC.Tdouble(clt)
	673	\| PC.Tfloat(clt) \| PC.Tlong(clt) \| PC.Tvoid(clt)
	674	\| PC.Tsize_t(clt) \| PC.Tssize_t(clt) \| PC.Tptrdiff_t(clt)
	675	\| PC.Tstruct(clt)
	676	\| PC.Tunion(clt) \| PC.Tenum(clt) \| PC.Tunsigned(clt) \| PC.Tsigned(clt)
	677	\| PC.Tstatic(clt) \| PC.Tauto(clt) \| PC.Tregister(clt) \| PC.Textern(clt)
	678	\| PC.Tinline(clt) \| PC.Ttypedef(clt) \| PC.Tattr(_,clt)
	679	\| PC.Tconst(clt) \| PC.Tvolatile(clt) -> split t clt
	680
	681	\| PC.TPragma(s,_) -> ([],[t]) (* only allowed in + *)
	682	\| PC.TPlusFile(s,clt) \| PC.TMinusFile(s,clt)
	683	\| PC.TIncludeL(s,clt) \| PC.TIncludeNL(s,clt) ->
	684	split t clt
	685	\| PC.TUndef(clt,_) \| PC.TDefine(clt,_) \| PC.TDefineParam(clt,_,_,_) ->
	686	split t clt
	687
	688	\| PC.TIf(clt) \| PC.TElse(clt) \| PC.TWhile(clt) \| PC.TFor(clt) \| PC.TDo(clt)
	689	\| PC.TSwitch(clt) \| PC.TCase(clt) \| PC.TDefault(clt)
	690	\| PC.TSizeof(clt)
	691	\| PC.TReturn(clt) \| PC.TBreak(clt) \| PC.TContinue(clt) \| PC.TGoto(clt)
	692	\| PC.TIdent(_,clt)
	693	\| PC.TTypeId(_,clt) \| PC.TDeclarerId(_,clt) \| PC.TIteratorId(_,clt)
	694	\| PC.TSymId(_,clt)
	695	\| PC.TMeta(_,_,clt) \| PC.TMetaConst(_,_,_,_,clt) \| PC.TMetaExp(_,_,_,_,clt)
	696	\| PC.TMetaIdExp(_,_,_,_,clt) \| PC.TMetaLocalIdExp(_,_,_,_,clt)
	697	\| PC.TMetaExpList(_,_,_,clt)
	698	\| PC.TMetaParam(_,_,clt) \| PC.TMetaParamList(_,_,_,clt)
	699	\| PC.TMetaId(_,_,_,_,clt) \| PC.TMetaType(_,_,clt)
	700	\| PC.TMetaInit(_,_,clt) \| PC.TMetaInitList(_,_,_,clt)
	701	\| PC.TMetaDecl(_,_,clt) \| PC.TMetaField(_,_,clt)
	702	\| PC.TMetaFieldList(_,_,_,clt)
	703	\| PC.TMetaStm(_,_,clt) \| PC.TMetaStmList(_,_,clt) \| PC.TMetaErr(_,_,_,clt)
	704	\| PC.TMetaFunc(_,_,_,clt) \| PC.TMetaLocalFunc(_,_,_,clt)
	705	\| PC.TMetaDeclarer(_,_,_,clt) \| PC.TMetaIterator(_,_,_,clt) -> split t clt
	706	\| PC.TMPtVirg \| PC.TArob \| PC.TArobArob \| PC.TScript
	707	\| PC.TInitialize \| PC.TFinalize -> ([t],[t])
	708	\| PC.TPArob clt \| PC.TMetaPos(_,_,_,clt) -> split t clt
	709
	710	\| PC.TFunDecl(clt)
	711	\| PC.TWhen(clt) \| PC.TWhenTrue(clt) \| PC.TWhenFalse(clt)
	712	\| PC.TAny(clt) \| PC.TStrict(clt) \| PC.TLineEnd(clt)
	713	\| PC.TEllipsis(clt) (* \| PC.TCircles(clt) \| PC.TStars(clt) *)
	714	\| PC.TOEllipsis(clt) \| PC.TCEllipsis(clt)
	715	\| PC.TPOEllipsis(clt) \| PC.TPCEllipsis(clt) -> split t clt
	716
	717	(*
	718	\| PC.TOCircles(_) \| PC.TCCircles(_) (* clt must be context *)
	719	\| PC.TOStars(_) \| PC.TCStars(_) (* clt must be context *)
	720	*)
	721
	722	\| PC.TBang0 \| PC.TPlus0 \| PC.TWhy0 ->
	723	([t],[t])
	724
	725	\| PC.TWhy(clt) \| PC.TDotDot(clt)
	726	\| PC.TBang(clt) \| PC.TOPar(clt) \| PC.TOPar0(clt)
	727	\| PC.TMid0(clt) \| PC.TCPar(clt) \| PC.TCPar0(clt) -> split t clt
	728
	729	\| PC.TInc(clt) \| PC.TDec(clt) -> split t clt
	730
	731	\| PC.TString(_,clt) \| PC.TChar(_,clt) \| PC.TFloat(_,clt) \| PC.TInt(_,clt) ->
	732	split t clt
	733
	734	\| PC.TOrLog(clt) \| PC.TAndLog(clt) \| PC.TOr(clt) \| PC.TXor(clt)
	735	\| PC.TAnd (clt) \| PC.TEqEq(clt) \| PC.TNotEq(clt) \| PC.TTildeEq(clt)
	736	\| PC.TTildeExclEq(clt) \| PC.TSub(clt) \| PC.TLogOp(_,clt)
	737	\| PC.TShLOp(_,clt) \| PC.TShROp(_,clt)
	738	\| PC.TPlus(clt) \| PC.TMinus(clt) \| PC.TMul(clt)
	739	\| PC.TDmOp(_,clt) \| PC.TTilde (clt) -> split t clt
	740
	741	\| PC.TOBrace(clt) \| PC.TCBrace(clt) \| PC.TOInit(clt) -> split t clt
	742	\| PC.TOCro(clt) \| PC.TCCro(clt) -> split t clt
	743
	744	\| PC.TPtrOp(clt) -> split t clt
	745
	746	\| PC.TEq(clt) \| PC.TAssign(_,clt) \| PC.TDot(clt) \| PC.TComma(clt)
	747	\| PC.TPtVirg(clt) -> split t clt
	748
	749	\| PC.EOF \| PC.TInvalid \| PC.TUnderscore -> ([t],[t])
	750
	751	\| PC.TIso \| PC.TRightIso
	752	\| PC.TIsoExpression \| PC.TIsoStatement \| PC.TIsoDeclaration \| PC.TIsoType
	753	\| PC.TIsoTopLevel \| PC.TIsoArgExpression \| PC.TIsoTestExpression
	754	\| PC.TIsoToTestExpression ->
	755	failwith "unexpected tokens"
	756	\| PC.TScriptData s -> ([t],[t])
	757
	758	let split_token_stream tokens =
	759	let rec loop = function
	760	[] -> ([],[])
	761	\| token::tokens ->
	762	let (minus,plus) = split_token token in
	763	let (minus_stream,plus_stream) = loop tokens in
	764	(minus@minus_stream,plus@plus_stream) in
	765	loop tokens
	766
	767	(* ----------------------------------------------------------------------- *)
	768	(* Find function names *)
	769	(* This addresses a shift-reduce problem in the parser, allowing us to
	770	distinguish a function declaration from a function call even if the latter
	771	has no return type. Undoubtedly, this is not very nice, but it doesn't
	772	seem very convenient to refactor the grammar to get around the problem. *)
	773
	774	exception Irrelevant
	775
	776	let rec find_function_names l =
	777	let is_ident = function
	778	(PC.TIdent(_,clt),info)
	779	\| (PC.TMeta(_,_,clt),info)
	780	\| (PC.TMetaId(_,_,_,_,clt),info)
	781	\| (PC.TMetaFunc(_,_,_,clt),info)
	782	\| (PC.TMetaLocalFunc(_,_,_,clt),info) -> true
	783	\| _ -> false in
	784	let is_mid = function
	785	(PC.TMid0(_),info) -> true
	786	\| _ -> false in
	787	let is_par = function
	788	(PC.TOPar0(_),info) -> true
	789	\| _ -> false in
	790	let rec split acc = function
	791	[] \| [_] -> raise Irrelevant
	792	\| ((PC.TCPar(_),_) as t1) :: ((PC.TOBrace(_),_) as t2) :: rest ->
	793	(List.rev (t1::acc),(t2::rest))
	794	\| x::xs -> split (x::acc) xs in
	795	let rec balanced_name level = function
	796	[] -> raise Irrelevant
	797	\| (PC.TCPar0(_),_)::rest ->
	798	let level = level - 1 in
	799	if level = 0
	800	then rest
	801	else balanced_name level rest
	802	\| (PC.TOPar0(_),_)::rest ->
	803	let level = level + 1 in
	804	balanced_name level rest
	805	\| (PC.TArobArob,_)::_ \| (PC.TArob,_)::_ \| (PC.EOF,_)::_ ->
	806	raise Irrelevant
	807	\| t::rest when is_ident t && level = 0 -> rest
	808	\| t::rest when is_ident t or is_mid t -> balanced_name level rest
	809	\| _ -> raise Irrelevant in
	810	let rec balanced_args level = function
	811	[] -> raise Irrelevant
	812	\| (PC.TCPar(_),_)::rest ->
	813	let level = level - 1 in
	814	if level = 0
	815	then rest
	816	else balanced_args level rest
	817	\| (PC.TOPar(_),_)::rest ->
	818	let level = level + 1 in
	819	balanced_args level rest
	820	\| (PC.TArobArob,_)::_ \| (PC.TArob,_)::_ \| (PC.EOF,_)::_ ->
	821	raise Irrelevant
	822	\| t::rest -> balanced_args level rest in
	823	let rec loop = function
	824	[] -> []
	825	\| t :: rest ->
	826	if is_par t or is_mid t or is_ident t
	827	then
	828	let (t,rest) =
	829	try
	830	let (bef,aft) = split [] (t::rest) in
	831	let rest = balanced_name 0 bef in
	832	(match rest with
	833	(PC.TOPar(_),_)::_ ->
	834	(match balanced_args 0 rest with
	835	[] ->
	836	let (_,info) as h = List.hd bef in
	837	let clt = get_clt h in
	838	(((PC.TFunDecl(clt),info) :: bef), aft)
	839	\| _ -> raise Irrelevant)
	840	\| _ -> raise Irrelevant)
	841	with Irrelevant -> ([t],rest) in
	842	t @ (loop rest)
	843	else t :: (loop rest) in
	844	loop l
	845
	846	(* ----------------------------------------------------------------------- *)
	847	(* an attribute is an identifier that preceeds another identifier and
	848	begins with __ *)
	849
	850	let rec detect_attr l =
	851	let is_id = function
	852	(PC.TIdent(_,_),_) \| (PC.TMetaId(_,_,_,_,_),_) \| (PC.TMetaFunc(_,_,_,_),_)
	853	\| (PC.TMetaLocalFunc(_,_,_,_),_) -> true
	854	\| _ -> false in
	855	let rec loop = function
	856	[] -> []
	857	\| [x] -> [x]
	858	\| ((PC.TIdent(nm,clt),info) as t1)::id::rest when is_id id ->
	859	if String.length nm > 2 && String.sub nm 0 2 = "__"
	860	then (PC.Tattr(nm,clt),info)::(loop (id::rest))
	861	else t1::(loop (id::rest))
	862	\| x::xs -> x::(loop xs) in
	863	loop l
	864
	865	(* ----------------------------------------------------------------------- *)
	866	(* Look for variable declarations where the name is a typedef name.
	867	We assume that C code does not contain a multiplication as a top-level
	868	statement. *)
	869
	870	(* bug: once a type, always a type, even if the same name is later intended
	871	to be used as a real identifier *)
	872	let detect_types in_meta_decls l =
	873	let is_delim infn = function
	874	(PC.TOEllipsis(_),_) (* \| (PC.TOCircles(_),_) \| (PC.TOStars(_),_) *)
	875	\| (PC.TPOEllipsis(_),_) (* \| (PC.TOCircles(_),_) \| (PC.TOStars(_),_) *)
	876	\| (PC.TEllipsis(_),_) (* \| (PC.TCircles(_),_) \| (PC.TStars(_),_) *)
	877	\| (PC.TPtVirg(_),_) \| (PC.TOBrace(_),_) \| (PC.TOInit(_),_)
	878	\| (PC.TCBrace(_),_)
	879	\| (PC.TPure,_) \| (PC.TContext,_)
	880	\| (PC.Tstatic(_),_) \| (PC.Textern(_),_)
	881	\| (PC.Tinline(_),_) \| (PC.Ttypedef(_),_) \| (PC.Tattr(_),_) -> true
	882	\| (PC.TComma(_),_) when infn > 0 or in_meta_decls -> true
	883	\| (PC.TDotDot(_),_) when in_meta_decls -> true
	884	\| _ -> false in
	885	let is_choices_delim = function
	886	(PC.TOBrace(_),_) \| (PC.TComma(_),_) -> true \| _ -> false in
	887	let is_id = function
	888	(PC.TIdent(_,_),_) \| (PC.TMetaId(_,_,_,_,_),_) \| (PC.TMetaFunc(_,_,_,_),_)
	889	\| (PC.TMetaLocalFunc(_,_,_,_),_) -> true
	890	\| (PC.TMetaParam(_,_,_),_)
	891	\| (PC.TMetaParamList(_,_,_,_),_)
	892	\| (PC.TMetaConst(_,_,_,_,_),_)
	893	\| (PC.TMetaErr(_,_,_,_),_)
	894	\| (PC.TMetaExp(_,_,_,_,_),_)
	895	\| (PC.TMetaIdExp(_,_,_,_,_),_)
	896	\| (PC.TMetaLocalIdExp(_,_,_,_,_),_)
	897	\| (PC.TMetaExpList(_,_,_,_),_)
	898	\| (PC.TMetaType(_,_,_),_)
	899	\| (PC.TMetaInit(_,_,_),_)
	900	\| (PC.TMetaInitList(_,_,_,_),_)
	901	\| (PC.TMetaDecl(_,_,_),_)
	902	\| (PC.TMetaField(_,_,_),_)
	903	\| (PC.TMetaFieldList(_,_,_,_),_)
	904	\| (PC.TMetaStm(_,_,_),_)
	905	\| (PC.TMetaStmList(_,_,_),_)
	906	\| (PC.TMetaPos(_,_,_,_),_) -> in_meta_decls
	907	\| _ -> false in
	908	let redo_id ident clt v =
	909	!Data.add_type_name ident;
	910	(PC.TTypeId(ident,clt),v) in
	911	let rec loop start infn type_names = function
	912	(* infn: 0 means not in a function header
	913	> 0 means in a function header, after infn - 1 unmatched open parens*)
	914	[] -> []
	915	\| ((PC.TOBrace(clt),v)::_) as all when in_meta_decls ->
	916	collect_choices type_names all (* never a function header *)
	917	\| delim::(PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest
	918	when is_delim infn delim ->
	919	let newid = redo_id ident clt v in
	920	delim::newid::x::(loop false infn (ident::type_names) rest)
	921	\| delim::(PC.TIdent(ident,clt),v)::id::rest
	922	when is_delim infn delim && is_id id ->
	923	let newid = redo_id ident clt v in
	924	delim::newid::id::(loop false infn (ident::type_names) rest)
	925	\| ((PC.TFunDecl(_),_) as fn)::rest ->
	926	fn::(loop false 1 type_names rest)
	927	\| ((PC.TOPar(_),_) as lp)::rest when infn > 0 ->
	928	lp::(loop false (infn + 1) type_names rest)
	929	\| ((PC.TCPar(_),_) as rp)::rest when infn > 0 ->
	930	if infn - 1 = 1
	931	then rp::(loop false 0 type_names rest) (* 0 means not in fn header *)
	932	else rp::(loop false (infn - 1) type_names rest)
	933	\| (PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest when start ->
	934	let newid = redo_id ident clt v in
	935	newid::x::(loop false infn (ident::type_names) rest)
	936	\| (PC.TIdent(ident,clt),v)::id::rest when start && is_id id ->
	937	let newid = redo_id ident clt v in
	938	newid::id::(loop false infn (ident::type_names) rest)
	939	\| (PC.TIdent(ident,clt),v)::rest when List.mem ident type_names ->
	940	(PC.TTypeId(ident,clt),v)::(loop false infn type_names rest)
	941	\| ((PC.TIdent(ident,clt),v) as x)::rest ->
	942	x::(loop false infn type_names rest)
	943	\| x::rest -> x::(loop false infn type_names rest)
	944	and collect_choices type_names = function
	945	[] -> [] (* should happen, but let the parser detect that *)
	946	\| (PC.TCBrace(clt),v)::rest ->
	947	(PC.TCBrace(clt),v)::(loop false 0 type_names rest)
	948	\| delim::(PC.TIdent(ident,clt),v)::rest
	949	when is_choices_delim delim ->
	950	let newid = redo_id ident clt v in
	951	delim::newid::(collect_choices (ident::type_names) rest)
	952	\| x::rest -> x::(collect_choices type_names rest) in
	953	loop true 0 [] l
	954
	955
	956	(* ----------------------------------------------------------------------- *)
	957	(* Insert TLineEnd tokens at the end of a line that contains a WHEN.
	958	WHEN is restricted to a single line, to avoid ambiguity in eg:
	959	... WHEN != x
	960	+3 *)
	961
	962	let token2line (tok,_) =
	963	match tok with
	964	PC.Tchar(clt) \| PC.Tshort(clt) \| PC.Tint(clt) \| PC.Tdouble(clt)
	965	\| PC.Tfloat(clt) \| PC.Tlong(clt) \| PC.Tvoid(clt)
	966	\| PC.Tsize_t(clt) \| PC.Tssize_t(clt) \| PC.Tptrdiff_t(clt)
	967	\| PC.Tstruct(clt)
	968	\| PC.Tunion(clt) \| PC.Tenum(clt) \| PC.Tunsigned(clt) \| PC.Tsigned(clt)
	969	\| PC.Tstatic(clt) \| PC.Tauto(clt) \| PC.Tregister(clt) \| PC.Textern(clt)
	970	\| PC.Tinline(clt) \| PC.Ttypedef(clt) \| PC.Tattr(_,clt) \| PC.Tconst(clt)
	971	\| PC.Tvolatile(clt)
	972
	973	\| PC.TInc(clt) \| PC.TDec(clt)
	974
	975	\| PC.TIf(clt) \| PC.TElse(clt) \| PC.TWhile(clt) \| PC.TFor(clt) \| PC.TDo(clt)
	976	\| PC.TSwitch (clt) \| PC.TCase (clt) \| PC.TDefault (clt) \| PC.TSizeof (clt)
	977	\| PC.TReturn(clt) \| PC.TBreak(clt) \| PC.TContinue(clt) \| PC.TGoto(clt)
	978	\| PC.TIdent(_,clt)
	979	\| PC.TTypeId(_,clt) \| PC.TDeclarerId(_,clt) \| PC.TIteratorId(_,clt)
	980	\| PC.TMetaDeclarer(_,_,_,clt) \| PC.TMetaIterator(_,_,_,clt)
	981
	982	\| PC.TSymId(_,clt)
	983
	984	\| PC.TString(_,clt) \| PC.TChar(_,clt) \| PC.TFloat(_,clt) \| PC.TInt(_,clt)
	985
	986	\| PC.TOrLog(clt) \| PC.TAndLog(clt) \| PC.TOr(clt) \| PC.TXor(clt)
	987	\| PC.TAnd (clt) \| PC.TEqEq(clt) \| PC.TNotEq(clt) \| PC.TLogOp(_,clt)
	988	\| PC.TShLOp(_,clt) \| PC.TShROp(_,clt)
	989	\| PC.TPlus(clt) \| PC.TMinus(clt) \| PC.TMul(clt)
	990	\| PC.TDmOp(_,clt) \| PC.TTilde (clt)
	991
	992	\| PC.TMeta(_,_,clt) \| PC.TMetaParam(_,_,clt) \| PC.TMetaParamList(_,_,_,clt)
	993	\| PC.TMetaConst(_,_,_,_,clt) \| PC.TMetaExp(_,_,_,_,clt)
	994	\| PC.TMetaIdExp(_,_,_,_,clt) \| PC.TMetaLocalIdExp(_,_,_,_,clt)
	995	\| PC.TMetaExpList(_,_,_,clt)
	996	\| PC.TMetaId(_,_,_,_,clt) \| PC.TMetaType(_,_,clt)
	997	\| PC.TMetaInit(_,_,clt) \| PC.TMetaInitList(_,_,_,clt)
	998	\| PC.TMetaDecl(_,_,clt) \| PC.TMetaField(_,_,clt)
	999	\| PC.TMetaFieldList(_,_,_,clt)
	1000	\| PC.TMetaStm(_,_,clt) \| PC.TMetaStmList(_,_,clt) \| PC.TMetaFunc(_,_,_,clt)
	1001	\| PC.TMetaLocalFunc(_,_,_,clt) \| PC.TMetaPos(_,_,_,clt)
	1002
	1003	\| PC.TFunDecl(clt)
	1004	\| PC.TWhen(clt) \| PC.TWhenTrue(clt) \| PC.TWhenFalse(clt)
	1005	\| PC.TAny(clt) \| PC.TStrict(clt) \| PC.TEllipsis(clt)
	1006	(* \| PC.TCircles(clt) \| PC.TStars(clt) *)
	1007
	1008	\| PC.TOEllipsis(clt) \| PC.TCEllipsis(clt)
	1009	\| PC.TPOEllipsis(clt) \| PC.TPCEllipsis(clt) (*\| PC.TOCircles(clt)
	1010	\| PC.TCCircles(clt) \| PC.TOStars(clt) \| PC.TCStars(clt) *)
	1011
	1012	\| PC.TWhy(clt) \| PC.TDotDot(clt) \| PC.TBang(clt) \| PC.TOPar(clt)
	1013	\| PC.TOPar0(clt) \| PC.TMid0(clt) \| PC.TCPar(clt)
	1014	\| PC.TCPar0(clt)
	1015
	1016	\| PC.TOBrace(clt) \| PC.TCBrace(clt) \| PC.TOCro(clt) \| PC.TCCro(clt)
	1017	\| PC.TOInit(clt)
	1018
	1019	\| PC.TPtrOp(clt)
	1020
	1021	\| PC.TUndef(clt,_) \| PC.TDefine(clt,_) \| PC.TDefineParam(clt,_,_,_)
	1022	\| PC.TIncludeL(_,clt) \| PC.TIncludeNL(_,clt)
	1023
	1024	\| PC.TEq(clt) \| PC.TAssign(_,clt) \| PC.TDot(clt) \| PC.TComma(clt)
	1025	\| PC.TPArob(clt) \| PC.TPtVirg(clt) ->
	1026	let (_,line,_,_,_,_,_,_) = clt in Some line
	1027
	1028	\| _ -> None
	1029
	1030	let rec insert_line_end = function
	1031	[] -> []
	1032	\| (((PC.TWhen(clt),q) as x)::xs) ->
	1033	x::(find_line_end true (token2line x) clt q xs)
	1034	\| (((PC.TUndef(clt,_),q) as x)::xs)
	1035	\| (((PC.TDefine(clt,_),q) as x)::xs)
	1036	\| (((PC.TDefineParam(clt,_,_,_),q) as x)::xs) ->
	1037	x::(find_line_end false (token2line x) clt q xs)
	1038	\| x::xs -> x::(insert_line_end xs)
	1039
	1040	and find_line_end inwhen line clt q = function
	1041	(* don't know what 2nd component should be so just use the info of
	1042	the When. Also inherit - of when, if any *)
	1043	[] -> [(PC.TLineEnd(clt),q)]
	1044	\| ((PC.TIdent("strict",clt),a) as x)::xs when token2line x = line ->
	1045	(PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs)
	1046	\| ((PC.TIdent("STRICT",clt),a) as x)::xs when token2line x = line ->
	1047	(PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs)
	1048	\| ((PC.TIdent("any",clt),a) as x)::xs when token2line x = line ->
	1049	(PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs)
	1050	\| ((PC.TIdent("ANY",clt),a) as x)::xs when token2line x = line ->
	1051	(PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs)
	1052	\| ((PC.TIdent("forall",clt),a) as x)::xs when token2line x = line ->
	1053	(PC.TForall,a) :: (find_line_end inwhen line clt q xs)
	1054	\| ((PC.TIdent("exists",clt),a) as x)::xs when token2line x = line ->
	1055	(PC.TExists,a) :: (find_line_end inwhen line clt q xs)
	1056	\| ((PC.TComma(clt),a) as x)::xs when token2line x = line ->
	1057	(PC.TComma(clt),a) :: (find_line_end inwhen line clt q xs)
	1058	\| ((PC.TPArob(clt),a) as x)::xs when token2line x = line ->
	1059	(PC.TPArob(clt),a) :: (find_line_end inwhen line clt q xs)
	1060	\| x::xs when token2line x = line -> x :: (find_line_end inwhen line clt q xs)
	1061	\| xs -> (PC.TLineEnd(clt),q)::(insert_line_end xs)
	1062
	1063	let rec translate_when_true_false = function
	1064	[] -> []
	1065	\| (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("true",_),_)::xs ->
	1066	(PC.TWhenTrue(clt),q)::x::(translate_when_true_false xs)
	1067	\| (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("false",_),_)::xs ->
	1068	(PC.TWhenFalse(clt),q)::x::(translate_when_true_false xs)
	1069	\| x::xs -> x :: (translate_when_true_false xs)
	1070
	1071	(* ----------------------------------------------------------------------- *)
	1072
	1073	(* In a nest, if the nest is -, all of the nested code must also be -. *)
	1074	let check_nests tokens =
	1075	let is_minus t =
	1076	let (line_type,a,b,c,d,e,f,g) = get_clt t in
	1077	List.mem line_type [D.MINUS;D.OPTMINUS;D.UNIQUEMINUS] in
	1078	let check_minus t =
	1079	let clt = try Some(get_clt t) with Failure _ -> None in
	1080	match clt with
	1081	Some (line_type,a,b,c,d,e,f,g) ->
	1082	(match line_type with
	1083	D.MINUS \| D.OPTMINUS \| D.UNIQUEMINUS -> t
	1084	\| _ -> failwith "minus token expected")
	1085	\| None -> t in
	1086	let rec outside = function
	1087	[] -> []
	1088	\| ((PC.TPOEllipsis(clt),q) as t)::r when is_minus t -> t :: inside 0 r
	1089	\| t::r -> t :: outside r
	1090	and inside stack = function
	1091	[] -> failwith "missing nest end"
	1092	\| ((PC.TPCEllipsis(clt),q) as t)::r ->
	1093	(check_minus t)
	1094	:: (if stack = 0 then outside r else inside (stack - 1) r)
	1095	\| ((PC.TPOEllipsis(clt),q) as t)::r ->
	1096	(check_minus t) :: (inside (stack + 1) r)
	1097	\| t :: r -> (check_minus t) :: (inside stack r) in
	1098	outside tokens
	1099
	1100	let check_parentheses tokens =
	1101	let clt2line (_,line,_,_,_,_,_,_) = line in
	1102	let rec loop seen_open = function
	1103	[] -> tokens
	1104	\| (PC.TOPar(clt),q) :: rest
	1105	\| (PC.TDefineParam(clt,_,_,_),q) :: rest ->
	1106	loop (Common.Left (clt2line clt) :: seen_open) rest
	1107	\| (PC.TOPar0(clt),q) :: rest ->
	1108	loop (Common.Right (clt2line clt) :: seen_open) rest
	1109	\| (PC.TCPar(clt),q) :: rest ->
	1110	(match seen_open with
	1111	[] ->
	1112	failwith
	1113	(Printf.sprintf
	1114	"unexpected close parenthesis in line %d\n" (clt2line clt))
	1115	\| Common.Left _ :: seen_open -> loop seen_open rest
	1116	\| Common.Right open_line :: _ ->
	1117	failwith
	1118	(Printf.sprintf
	1119	"disjunction parenthesis in line %d column 0 matched to normal parenthesis on line %d\n" open_line (clt2line clt)))
	1120	\| (PC.TCPar0(clt),q) :: rest ->
	1121	(match seen_open with
	1122	[] ->
	1123	failwith
	1124	(Printf.sprintf
	1125	"unexpected close parenthesis in line %d\n" (clt2line clt))
	1126	\| Common.Right _ :: seen_open -> loop seen_open rest
	1127	\| Common.Left open_line :: _ ->
	1128	failwith
	1129	(Printf.sprintf
	1130	"normal parenthesis in line %d matched to disjunction parenthesis on line %d column 0\n" open_line (clt2line clt)))
	1131	\| x::rest -> loop seen_open rest in
	1132	loop [] tokens
	1133
	1134	(* ----------------------------------------------------------------------- *)
	1135	(* top level initializers: a sequence of braces followed by a dot *)
	1136
	1137	let find_top_init tokens =
	1138	match tokens with
	1139	(PC.TOBrace(clt),q) :: rest ->
	1140	let rec dot_start acc = function
	1141	((PC.TOBrace(_),_) as x) :: rest ->
	1142	dot_start (x::acc) rest
	1143	\| ((PC.TDot(_),_) :: rest) as x ->
	1144	Some ((PC.TOInit(clt),q) :: (List.rev acc) @ x)
	1145	\| l -> None in
	1146	let rec comma_end acc = function
	1147	((PC.TCBrace(_),_) as x) :: rest ->
	1148	comma_end (x::acc) rest
	1149	\| ((PC.TComma(_),_) :: rest) as x ->
	1150	Some ((PC.TOInit(clt),q) :: (List.rev x) @ acc)
	1151	\| l -> None in
	1152	(match dot_start [] rest with
	1153	Some x -> x
	1154	\| None ->
	1155	(match List.rev rest with
	1156	(* not super sure what this does, but EOF, @, and @@ should be
	1157	the same, markind the end of a rule *)
	1158	((PC.EOF,_) as x)::rest \| ((PC.TArob,_) as x)::rest
	1159	\| ((PC.TArobArob,_) as x)::rest ->
	1160	(match comma_end [x] rest with
	1161	Some x -> x
	1162	\| None -> tokens)
	1163	\| _ ->
	1164	failwith "unexpected empty token list"))
	1165	\| _ -> tokens
	1166
	1167	(* ----------------------------------------------------------------------- *)
	1168	(* Integrate pragmas into some adjacent token. + tokens are preferred. Dots
	1169	are not allowed. *)
	1170
	1171	let rec collect_all_pragmas collected = function
	1172	(PC.TPragma(s,(_,line,logical_line,offset,col,_,_,pos)),_)::rest ->
	1173	let i =
	1174	{ Ast0.line_start = line; Ast0.line_end = line;
	1175	Ast0.logical_start = logical_line; Ast0.logical_end = logical_line;
	1176	Ast0.column = col; Ast0.offset = offset; } in
	1177	collect_all_pragmas ((s,i)::collected) rest
	1178	\| l -> (List.rev collected,l)
	1179
	1180	let rec collect_pass = function
	1181	[] -> ([],[])
	1182	\| x::xs ->
	1183	match plus_attachable false x with
	1184	SKIP ->
	1185	let (pass,rest) = collect_pass xs in
	1186	(x::pass,rest)
	1187	\| _ -> ([],x::xs)
	1188
	1189	let plus_attach strict = function
	1190	None -> NOTPLUS
	1191	\| Some x -> plus_attachable strict x
	1192
	1193	let add_bef = function Some x -> [x] \| None -> []
	1194
	1195	(*skips should be things like line end
	1196	skips is things before pragmas that can't be attached to, pass is things
	1197	after. pass is used immediately. skips accumulates.
	1198	When stuff is added before some + code, the logical line of the + code
	1199	becomes that of the pragma. context_neg relies on things that are adjacent
	1200	having sequential logical lines. Not sure that this is good enough,
	1201	as it might result in later gaps in the logical lines... *)
	1202	let rec process_pragmas bef skips = function
	1203	[] -> add_bef bef @ List.rev skips
	1204	\| ((PC.TPragma(s,i),_)::_) as l ->
	1205	let (pragmas,rest) = collect_all_pragmas [] l in
	1206	let (pass,rest0) = collect_pass rest in
	1207	let (_,_,prag_lline,_,_,_,_,_) = i in
	1208	let (next,rest) =
	1209	match rest0 with [] -> (None,[]) \| next::rest -> (Some next,rest) in
	1210	(match (bef,plus_attach true bef,next,plus_attach true next) with
	1211	(Some bef,PLUS,_,_) ->
	1212	let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
	1213	(update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@
	1214	pass@process_pragmas None [] rest0
	1215	\| (_,_,Some next,PLUS) ->
	1216	let (a,b,lline,d,e,strbef,straft,pos) = get_clt next in
	1217	(add_bef bef) @ List.rev skips @ pass @
	1218	(process_pragmas
	1219	(Some (update_clt next (a,b,prag_lline,d,e,pragmas,straft,pos)))
	1220	[] rest)
	1221	\| _ ->
	1222	(match (bef,plus_attach false bef,next,plus_attach false next) with
	1223	(Some bef,PLUS,_,_) ->
	1224	let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
	1225	(update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@
	1226	pass@process_pragmas None [] rest0
	1227	\| (_,_,Some next,PLUS) ->
	1228	let (a,b,lline,d,e,strbef,straft,pos) = get_clt next in
	1229	(add_bef bef) @ List.rev skips @ pass @
	1230	(process_pragmas
	1231	(Some
	1232	(update_clt next (a,b,prag_lline,d,e,pragmas,straft,pos)))
	1233	[] rest)
	1234	\| _ -> failwith "nothing to attach pragma to"))
	1235	\| x::xs ->
	1236	(match plus_attachable false x with
	1237	SKIP -> process_pragmas bef (x::skips) xs
	1238	\| _ -> (add_bef bef) @ List.rev skips @ (process_pragmas (Some x) [] xs))
	1239
	1240	(* ----------------------------------------------------------------------- *)
	1241	(* Drop ... ... . This is only allowed in + code, and arises when there is
	1242	some - code between the ... *)
	1243	(* drop whens as well - they serve no purpose in + code and they cause
	1244	problems for drop_double_dots *)
	1245
	1246	let rec drop_when = function
	1247	[] -> []
	1248	\| (PC.TWhen(clt),info)::xs ->
	1249	let rec loop = function
	1250	[] -> []
	1251	\| (PC.TLineEnd(_),info)::xs -> drop_when xs
	1252	\| x::xs -> loop xs in
	1253	loop xs
	1254	\| x::xs -> x::drop_when xs
	1255
	1256	(* instead of dropping the double dots, we put TNothing in between them.
	1257	these vanish after the parser, but keeping all the ...s in the + code makes
	1258	it easier to align the + and - code in context_neg and in preparation for the
	1259	isomorphisms. This shouldn't matter because the context code of the +
	1260	slice is mostly ignored anyway *)
	1261	let minus_to_nothing l =
	1262	(* for cases like \| <..., which may or may not arise from removing minus
	1263	code, depending on whether <... is a statement or expression *)
	1264	let is_minus tok =
	1265	try
	1266	let (d,_,_,_,_,_,_,_) = get_clt tok in
	1267	(match d with
	1268	D.MINUS \| D.OPTMINUS \| D.UNIQUEMINUS -> true
	1269	\| D.PLUS \| D.PLUSPLUS -> false
	1270	\| D.CONTEXT \| D.UNIQUE \| D.OPT -> false)
	1271	with _ -> false in
	1272	let rec minus_loop = function
	1273	[] -> []
	1274	\| (d::ds) as l -> if is_minus d then minus_loop ds else l in
	1275	let rec loop = function
	1276	[] -> []
	1277	\| ((PC.TMid0(clt),i) as x)::t1::ts when is_minus t1 ->
	1278	(match minus_loop ts with
	1279	((PC.TOEllipsis(_),_)::_) \| ((PC.TPOEllipsis(_),_)::_)
	1280	\| ((PC.TEllipsis(_),_)::_) as l -> x::(PC.TNothing,i)::(loop l)
	1281	\| l -> x::(loop l))
	1282	\| t::ts -> t::(loop ts) in
	1283	loop l
	1284
	1285	let rec drop_double_dots l =
	1286	let start = function
	1287	(PC.TOEllipsis(_),_) \| (PC.TPOEllipsis(_),_)
	1288	(* \| (PC.TOCircles(_),_) \| (PC.TOStars(_),_) *) ->
	1289	true
	1290	\| _ -> false in
	1291	let middle = function
	1292	(PC.TEllipsis(_),_) (* \| (PC.TCircles(_),_) \| (PC.TStars(_),_) *) -> true
	1293	\| _ -> false in
	1294	let whenline = function
	1295	(PC.TLineEnd(_),_) -> true
	1296	(\| (PC.TMid0(_),_) -> true)
	1297	\| _ -> false in
	1298	let final = function
	1299	(PC.TCEllipsis(_),_) \| (PC.TPCEllipsis(_),_)
	1300	(* \| (PC.TCCircles(_),_) \| (PC.TCStars(_),_) *) ->
	1301	true
	1302	\| _ -> false in
	1303	let any_before x = start x or middle x or final x or whenline x in
	1304	let any_after x = start x or middle x or final x in
	1305	let rec loop ((_,i) as prev) = function
	1306	[] -> []
	1307	\| x::rest when any_before prev && any_after x ->
	1308	(PC.TNothing,i)::x::(loop x rest)
	1309	\| ((PC.TComma(_),_) as c)::x::rest when any_before prev && any_after x ->
	1310	c::(PC.TNothing,i)::x::(loop x rest)
	1311	\| x::rest -> x :: (loop x rest) in
	1312	match l with
	1313	[] -> []
	1314	\| (x::xs) -> x :: loop x xs
	1315
	1316	(* ignore uncomparable pcre regular expressions *)
	1317	let strip_for_fix l =
	1318	List.map
	1319	(function
	1320	(PC.TMetaId(nm,_,seed,pure,clt),info) ->
	1321	(PC.TMetaId(nm,Ast.IdNoConstraint,seed,pure,clt),info)
	1322	\| (PC.TMetaFunc(nm,_,pure,clt),info) ->
	1323	(PC.TMetaFunc(nm,Ast.IdNoConstraint,pure,clt),info)
	1324	\| (PC.TMetaLocalFunc(nm,_,pure,clt),info) ->
	1325	(PC.TMetaLocalFunc(nm,Ast.IdNoConstraint,pure,clt),info)
	1326	\| (PC.TMetaErr(nm,_,pure,clt),info) ->
	1327	(PC.TMetaErr(nm,Ast0.NoConstraint,pure,clt),info)
	1328	\| (PC.TMetaExp(nm,_,pure,ty,clt),info) ->
	1329	(PC.TMetaExp(nm,Ast0.NoConstraint,pure,ty,clt),info)
	1330	\| (PC.TMetaIdExp(nm,_,pure,ty,clt),info) ->
	1331	(PC.TMetaIdExp(nm,Ast0.NoConstraint,pure,ty,clt),info)
	1332	\| (PC.TMetaLocalIdExp(nm,_,pure,ty,clt),info) ->
	1333	(PC.TMetaLocalIdExp(nm,Ast0.NoConstraint,pure,ty,clt),info)
	1334	\| (PC.TMetaConst(nm,_,pure,ty,clt),info) ->
	1335	(PC.TMetaConst(nm,Ast0.NoConstraint,pure,ty,clt),info)
	1336	\| t -> t)
	1337	l
	1338
	1339	let fix f l =
	1340	let rec loop f l stripped_l =
	1341	let cur = f l in
	1342	let stripped_cur = strip_for_fix cur in
	1343	if stripped_l = stripped_cur then l else loop f cur stripped_cur in
	1344	loop f l (strip_for_fix l)
	1345
	1346	(* ( \| ... \| ) also causes parsing problems *)
	1347
	1348	exception Not_empty
	1349
	1350	let rec drop_empty_thing starter middle ender = function
	1351	[] -> []
	1352	\| hd::rest when starter hd ->
	1353	let rec loop = function
	1354	x::rest when middle x -> loop rest
	1355	\| x::rest when ender x -> rest
	1356	\| _ -> raise Not_empty in
	1357	(match try Some(loop rest) with Not_empty -> None with
	1358	Some x -> drop_empty_thing starter middle ender x
	1359	\| None -> hd :: drop_empty_thing starter middle ender rest)
	1360	\| x::rest -> x :: drop_empty_thing starter middle ender rest
	1361
	1362	let drop_empty_or =
	1363	drop_empty_thing
	1364	(function (PC.TOPar0(_),_) -> true \| _ -> false)
	1365	(function (PC.TMid0(_),_) -> true \| _ -> false)
	1366	(function (PC.TCPar0(_),_) -> true \| _ -> false)
	1367
	1368	let drop_empty_nest = drop_empty_thing
	1369
	1370	(* ----------------------------------------------------------------------- *)
	1371	(* Read tokens *)
	1372
	1373	let get_s_starts (_, (s,_,(starts, ends))) =
	1374	Printf.printf "%d %d\n" starts ends; (s, starts)
	1375
	1376	let pop2 l =
	1377	let v = List.hd !l in
	1378	l := List.tl !l;
	1379	v
	1380
	1381	let reinit _ =
	1382	PC.reinit (function _ -> PC.TArobArob (* a handy token *))
	1383	(Lexing.from_function
	1384	(function buf -> function n -> raise (Common.Impossible 157)))
	1385
	1386	let parse_one str parsefn file toks =
	1387	let all_tokens = ref toks in
	1388	let cur_tok = ref (List.hd !all_tokens) in
	1389
	1390	let lexer_function _ =
	1391	let (v, info) = pop2 all_tokens in
	1392	cur_tok := (v, info);
	1393	v in
	1394
	1395	let lexbuf_fake =
	1396	Lexing.from_function
	1397	(function buf -> function n -> raise (Common.Impossible 158))
	1398	in
	1399
	1400	reinit();
	1401
	1402	try parsefn lexer_function lexbuf_fake
	1403	with
	1404	Lexer_cocci.Lexical s ->
	1405	failwith
	1406	(Printf.sprintf "%s: lexical error: %s\n =%s\n" str s
	1407	(Common.error_message file (get_s_starts !cur_tok) ))
	1408	\| Parser_cocci_menhir.Error ->
	1409	failwith
	1410	(Printf.sprintf "%s: parse error: \n = %s\n" str
	1411	(Common.error_message file (get_s_starts !cur_tok) ))
	1412	\| Semantic_cocci.Semantic s ->
	1413	failwith
	1414	(Printf.sprintf "%s: semantic error: %s\n =%s\n" str s
	1415	(Common.error_message file (get_s_starts !cur_tok) ))
	1416
	1417	\| e -> raise e
	1418
	1419	let prepare_tokens tokens =
	1420	find_top_init
	1421	(translate_when_true_false (* after insert_line_end *)
	1422	(insert_line_end
	1423	(detect_types false
	1424	(find_function_names
	1425	(detect_attr
	1426	(check_nests
	1427	(check_parentheses tokens)))))))
	1428
	1429	let prepare_mv_tokens tokens =
	1430	detect_types false (detect_attr tokens)
	1431
	1432	let unminus (d,x1,x2,x3,x4,x5,x6,x7) = (* for hidden variables *)
	1433	match d with
	1434	D.MINUS \| D.OPTMINUS \| D.UNIQUEMINUS -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7)
	1435	\| D.PLUS -> failwith "unexpected plus code"
	1436	\| D.PLUSPLUS -> failwith "unexpected plus code"
	1437	\| D.CONTEXT \| D.UNIQUE \| D.OPT -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7)
	1438
	1439	let process_minus_positions x name clt meta =
	1440	let (arity,ln,lln,offset,col,strbef,straft,pos) = get_clt x in
	1441	let name = Parse_aux.clt2mcode name (unminus clt) in
	1442	update_clt x (arity,ln,lln,offset,col,strbef,straft,meta name::pos)
	1443
	1444	(* first attach positions, then the others, so that positions can refer to
	1445	the larger term represented by the preceding metavariable *)
	1446	let rec consume_minus_positions toks =
	1447	let rec loop_pos = function
	1448	[] -> []
	1449	\| ((PC.TOPar0(_),_) as x)::xs \| ((PC.TCPar0(_),_) as x)::xs
	1450	\| ((PC.TMid0(_),_) as x)::xs -> x::loop_pos xs
	1451	\| x::(PC.TPArob _,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
	1452	let x =
	1453	process_minus_positions x name clt
	1454	(function name ->
	1455	Ast0.MetaPosTag(Ast0.MetaPos(name,constraints,per))) in
	1456	(loop_pos (x::xs))
	1457	\| x::xs -> x::loop_pos xs in
	1458	let rec loop_other = function
	1459	[] -> []
	1460	\| ((PC.TOPar0(_),_) as x)::xs \| ((PC.TCPar0(_),_) as x)::xs
	1461	\| ((PC.TMid0(_),_) as x)::xs -> x::loop_other xs
	1462	\| x::(PC.TPArob _,_)::(PC.TMetaId(name,constraints,seed,pure,clt),_)::xs ->
	1463	let x =
	1464	process_minus_positions x name clt
	1465	(function name ->
	1466	Ast0.IdentTag
	1467	(Ast0.wrap
	1468	(Ast0.MetaId(name,constraints,seed,pure)))) in
	1469	(loop_other (x::xs))
	1470	\| x::(PC.TPArob _,_)::(PC.TMetaExp(name,constraints,pure,ty,clt),_)::xs ->
	1471	let x =
	1472	process_minus_positions x name clt
	1473	(function name ->
	1474	Ast0.ExprTag
	1475	(Ast0.wrap
	1476	(Ast0.MetaExpr(name,constraints,ty,Ast.ANY,pure)))) in
	1477	(loop_other (x::xs))
	1478	\| x::(PC.TPArob _,_)::(PC.TMetaInit(name,pure,clt),_)::xs ->
	1479	let x =
	1480	process_minus_positions x name clt
	1481	(function name ->
	1482	Ast0.InitTag(Ast0.wrap(Ast0.MetaInit(name,pure)))) in
	1483	(loop_other (x::xs))
	1484	\| x::(PC.TPArob _,_)::(PC.TMetaType(name,pure,clt),_)::xs ->
	1485	let x =
	1486	process_minus_positions x name clt
	1487	(function name ->
	1488	Ast0.TypeCTag(Ast0.wrap(Ast0.MetaType(name,pure)))) in
	1489	(loop_other (x::xs))
	1490	\| x::(PC.TPArob _,_)::(PC.TMetaDecl(name,pure,clt),_)::xs ->
	1491	let x =
	1492	process_minus_positions x name clt
	1493	(function name ->
	1494	Ast0.DeclTag(Ast0.wrap(Ast0.MetaDecl(name,pure)))) in
	1495	(loop_other (x::xs))
	1496	\| x::(PC.TPArob _,_)::(PC.TMetaStm(name,pure,clt),_)::xs ->
	1497	let x =
	1498	process_minus_positions x name clt
	1499	(function name ->
	1500	Ast0.StmtTag(Ast0.wrap(Ast0.MetaStmt(name,pure)))) in
	1501	(loop_other (x::xs))
	1502	\| x::xs -> x::loop_other xs in
	1503	loop_other(loop_pos toks)
	1504
	1505	let rec consume_plus_positions = function
	1506	[] -> []
	1507	\| (PC.TPArob _,_)::x::xs -> consume_plus_positions xs
	1508	\| x::xs -> x::consume_plus_positions xs
	1509
	1510	let any_modif rule =
	1511	let mcode x =
	1512	match Ast0.get_mcode_mcodekind x with
	1513	Ast0.MINUS _ \| Ast0.PLUS _ -> true
	1514	\| _ -> false in
	1515	let donothing r k e = k e in
	1516	let bind x y = x or y in
	1517	let option_default = false in
	1518	let fn =
	1519	V0.flat_combiner bind option_default
	1520	mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
	1521	donothing donothing donothing donothing donothing donothing
	1522	donothing donothing donothing donothing donothing donothing donothing
	1523	donothing donothing donothing in
	1524	List.exists fn.VT0.combiner_rec_top_level rule
	1525
	1526	let eval_virt virt =
	1527	List.iter
	1528	(function x ->
	1529	if not (List.mem x virt)
	1530	then raise (Bad_virt x))
	1531	!Flag.defined_virtual_rules
	1532
	1533	let drop_last extra l = List.rev(extra@(List.tl(List.rev l)))
	1534
	1535	let partition_either l =
	1536	let rec part_either left right = function
	1537	\| [] -> (List.rev left, List.rev right)
	1538	\| x :: l ->
	1539	(match x with
	1540	\| Common.Left e -> part_either (e :: left) right l
	1541	\| Common.Right e -> part_either left (e :: right) l) in
	1542	part_either [] [] l
	1543
	1544	let get_metavars parse_fn table file lexbuf =
	1545	let rec meta_loop acc (* read one decl at a time *) =
	1546	let (_,tokens) =
	1547	Data.call_in_meta
	1548	(function _ ->
	1549	tokens_all table file true lexbuf [PC.TArobArob;PC.TMPtVirg]) in
	1550	let tokens = prepare_mv_tokens tokens in
	1551	match tokens with
	1552	[(PC.TArobArob,_)] -> List.rev acc
	1553	\| _ ->
	1554	let metavars = parse_one "meta" parse_fn file tokens in
	1555	meta_loop (metavars@acc) in
	1556	partition_either (meta_loop [])
	1557
	1558	let get_script_metavars parse_fn table file lexbuf =
	1559	let rec meta_loop acc =
	1560	let (_, tokens) =
	1561	tokens_all table file true lexbuf [PC.TArobArob; PC.TMPtVirg] in
	1562	let tokens = prepare_tokens tokens in
	1563	match tokens with
	1564	[(PC.TArobArob, _)] -> List.rev acc
	1565	\| _ ->
	1566	let metavar = parse_one "scriptmeta" parse_fn file tokens in
	1567	meta_loop (metavar :: acc)
	1568	in
	1569	meta_loop []
	1570
	1571	let get_rule_name parse_fn starts_with_name get_tokens file prefix =
	1572	Data.in_rule_name := true;
	1573	let mknm _ = make_name prefix (!Lexer_cocci.line) in
	1574	let name_res =
	1575	if starts_with_name
	1576	then
	1577	let (_,tokens) = get_tokens [PC.TArob] in
	1578	let check_name = function
	1579	None -> Some (mknm())
	1580	\| Some nm ->
	1581	(if List.mem nm reserved_names
	1582	then failwith (Printf.sprintf "invalid name %s\n" nm));
	1583	Some nm in
	1584	match parse_one "rule name" parse_fn file tokens with
	1585	Ast.CocciRulename (nm,a,b,c,d,e) ->
	1586	Ast.CocciRulename (check_name nm,a,b,c,d,e)
	1587	\| Ast.GeneratedRulename (nm,a,b,c,d,e) ->
	1588	Ast.GeneratedRulename (check_name nm,a,b,c,d,e)
	1589	\| Ast.ScriptRulename(nm,s,deps) ->
	1590	Ast.ScriptRulename(check_name nm,s,deps)
	1591	\| Ast.InitialScriptRulename(_,s,deps) ->
	1592	Ast.InitialScriptRulename(check_name None,s,deps)
	1593	\| Ast.FinalScriptRulename(_,s,deps) ->
	1594	Ast.FinalScriptRulename(check_name None,s,deps)
	1595	else
	1596	Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined,false) in
	1597	Data.in_rule_name := false;
	1598	name_res
	1599
	1600	let parse_iso file =
	1601	let table = Common.full_charpos_to_pos file in
	1602	Common.with_open_infile file (fun channel ->
	1603	let lexbuf = Lexing.from_channel channel in
	1604	let get_tokens = tokens_all table file false lexbuf in
	1605	let res =
	1606	match get_tokens [PC.TArobArob;PC.TArob] with
	1607	(true,start) ->
	1608	let parse_start start =
	1609	let rev = List.rev start in
	1610	let (arob,_) = List.hd rev in
	1611	(arob = PC.TArob,List.rev(List.tl rev)) in
	1612	let (starts_with_name,start) = parse_start start in
	1613	let rec loop starts_with_name start =
	1614	(!Data.init_rule)();
	1615	(* get metavariable declarations - have to be read before the
	1616	rest *)
	1617	let (rule_name,_,_,_,_,_) =
	1618	match get_rule_name PC.iso_rule_name starts_with_name get_tokens
	1619	file ("iso file "^file) with
	1620	Ast.CocciRulename (Some n,a,b,c,d,e) -> (n,a,b,c,d,e)
	1621	\| _ -> failwith "Script rules cannot appear in isomorphism rules"
	1622	in
	1623	Ast0.rule_name := rule_name;
	1624	let iso_metavars =
	1625	match get_metavars PC.iso_meta_main table file lexbuf with
	1626	(iso_metavars,[]) -> iso_metavars
	1627	\| _ -> failwith "unexpected inheritance in iso" in
	1628	(* get the rule *)
	1629	let (more,tokens) =
	1630	get_tokens
	1631	[PC.TIsoStatement;PC.TIsoExpression;PC.TIsoArgExpression;
	1632	PC.TIsoTestExpression; PC.TIsoToTestExpression;
	1633	PC.TIsoDeclaration;PC.TIsoType;PC.TIsoTopLevel] in
	1634	let next_start = List.hd(List.rev tokens) in
	1635	let dummy_info = ("",(-1,-1),(-1,-1)) in
	1636	let tokens = drop_last [(PC.EOF,dummy_info)] tokens in
	1637	let tokens = prepare_tokens (start@tokens) in
	1638	(*
	1639	print_tokens "iso tokens" tokens;
	1640	*)
	1641	let entry = parse_one "iso main" PC.iso_main file tokens in
	1642	let entry = List.map (List.map Test_exps.process_anything) entry in
	1643	if more
	1644	then (* The code below allows a header like Statement list,
	1645	which is more than one word. We don't have that any more,
	1646	but the code is left here in case it is put back. *)
	1647	match get_tokens [PC.TArobArob;PC.TArob] with
	1648	(true,start) ->
	1649	let (starts_with_name,start) = parse_start start in
	1650	(iso_metavars,entry,rule_name) ::
	1651	(loop starts_with_name (next_start::start))
	1652	\| _ -> failwith "isomorphism ends early"
	1653	else [(iso_metavars,entry,rule_name)] in
	1654	loop starts_with_name start
	1655	\| (false,_) -> [] in
	1656	List.iter Iso_compile.process res;
	1657	res)
	1658
	1659	let parse_iso_files existing_isos iso_files extra_path =
	1660	let get_names = List.map (function (_,_,nm) -> nm) in
	1661	let old_names = get_names existing_isos in
	1662	Data.in_iso := true;
	1663	let (res,_) =
	1664	List.fold_left
	1665	(function (prev,names) ->
	1666	function file ->
	1667	let file =
	1668	match file with
	1669	Common.Left(fl) -> Filename.concat extra_path fl
	1670	\| Common.Right(fl) -> Filename.concat Config.path fl in
	1671	Lexer_cocci.init ();
	1672	let current = parse_iso file in
	1673	let new_names = get_names current in
	1674	if List.exists (function x -> List.mem x names) new_names
	1675	then failwith (Printf.sprintf "repeated iso name found in %s" file);
	1676	(current::prev,new_names @ names))
	1677	([],old_names) iso_files in
	1678	Data.in_iso := false;
	1679	existing_isos@(List.concat (List.rev res))
	1680
	1681	(* None = dependency not satisfied
	1682	Some dep = dependency satisfied or unknown and dep has virts optimized
	1683	away *)
	1684	let eval_depend dep virt =
	1685	let rec loop dep =
	1686	match dep with
	1687	Ast.Dep req \| Ast.EverDep req ->
	1688	if List.mem req virt
	1689	then
	1690	if List.mem req !Flag.defined_virtual_rules
	1691	then Ast.NoDep
	1692	else Ast.FailDep
	1693	else dep
	1694	\| Ast.AntiDep antireq \| Ast.NeverDep antireq ->
	1695	if List.mem antireq virt
	1696	then
	1697	if not(List.mem antireq !Flag.defined_virtual_rules)
	1698	then Ast.NoDep
	1699	else Ast.FailDep
	1700	else dep
	1701	\| Ast.AndDep(d1,d2) ->
	1702	(match (loop d1, loop d2) with
	1703	(Ast.NoDep,x) \| (x,Ast.NoDep) -> x
	1704	\| (Ast.FailDep,x) \| (x,Ast.FailDep) -> Ast.FailDep
	1705	\| (x,y) -> Ast.AndDep(x,y))
	1706	\| Ast.OrDep(d1,d2) ->
	1707	(match (loop d1, loop d2) with
	1708	(Ast.NoDep,x) \| (x,Ast.NoDep) -> Ast.NoDep
	1709	\| (Ast.FailDep,x) \| (x,Ast.FailDep) -> x
	1710	\| (x,y) -> Ast.OrDep(x,y))
	1711	\| Ast.NoDep \| Ast.FailDep -> dep
	1712	in
	1713	loop dep
	1714
	1715	let parse file =
	1716	Lexer_cocci.init ();
	1717	let rec parse_loop file =
	1718	Lexer_cocci.include_init ();
	1719	let table = Common.full_charpos_to_pos file in
	1720	Common.with_open_infile file (fun channel ->
	1721	let lexbuf = Lexing.from_channel channel in
	1722	let get_tokens = tokens_all table file false lexbuf in
	1723	Data.in_prolog := true;
	1724	let initial_tokens = get_tokens [PC.TArobArob;PC.TArob] in
	1725	Data.in_prolog := false;
	1726	let res =
	1727	match initial_tokens with
	1728	(true,data) ->
	1729	(match List.rev data with
	1730	((PC.TArobArob as x),_)::_ \| ((PC.TArob as x),_)::_ ->
	1731	let include_and_iso_files =
	1732	parse_one "include and iso file names" PC.include_main file data in
	1733
	1734	let (include_files,iso_files,virt) =
	1735	List.fold_left
	1736	(function (include_files,iso_files,virt) ->
	1737	function
	1738	Data.Include s -> (s::include_files,iso_files,virt)
	1739	\| Data.Iso s -> (include_files,s::iso_files,virt)
	1740	\| Data.Virt l -> (include_files,iso_files,l@virt))
	1741	([],[],[]) include_and_iso_files in
	1742
	1743	List.iter (function x -> Hashtbl.add Lexer_cocci.rule_names x ())
	1744	virt;
	1745
	1746	let (extra_iso_files, extra_rules, extra_virt, extra_metas) =
	1747	let rec loop = function
	1748	[] -> ([],[],[],[])
	1749	\| (a,b,c,d)::rest ->
	1750	let (x,y,z,zz) = loop rest in
	1751	(a::x,b::y,c::z,d@zz) in
	1752	loop (List.map parse_loop include_files) in
	1753
	1754	let parse_cocci_rule ruletype old_metas
	1755	(rule_name, dependencies, iso, dropiso, exists, is_expression) =
	1756	let dropiso = !Flag_parsing_cocci.disabled_isos @ dropiso in
	1757	Ast0.rule_name := rule_name;
	1758	Data.inheritable_positions :=
	1759	rule_name :: !Data.inheritable_positions;
	1760
	1761	(* get metavariable declarations *)
	1762	let (metavars, inherited_metavars) =
	1763	get_metavars PC.meta_main table file lexbuf in
	1764	Hashtbl.add Data.all_metadecls rule_name metavars;
	1765	Hashtbl.add Lexer_cocci.rule_names rule_name ();
	1766	Hashtbl.add Lexer_cocci.all_metavariables rule_name
	1767	(Hashtbl.fold
	1768	(fun key v rest -> (key,v)::rest)
	1769	Lexer_cocci.metavariables []);
	1770
	1771	(* get transformation rules *)
	1772	let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
	1773	let (minus_tokens, _) = split_token_stream tokens in
	1774	let (_, plus_tokens) =
	1775	split_token_stream (minus_to_nothing tokens) in
	1776
	1777	(*
	1778	print_tokens "minus tokens" minus_tokens;
	1779	print_tokens "plus tokens" plus_tokens;
	1780	*)
	1781
	1782	let minus_tokens = consume_minus_positions minus_tokens in
	1783	let plus_tokens = consume_plus_positions plus_tokens in
	1784	let minus_tokens = prepare_tokens minus_tokens in
	1785	let plus_tokens = prepare_tokens plus_tokens in
	1786
	1787	(*
	1788	print_tokens "minus tokens" minus_tokens;
	1789	print_tokens "plus tokens" plus_tokens;
	1790	*)
	1791
	1792	let plus_tokens =
	1793	process_pragmas None []
	1794	(fix (function x -> drop_double_dots (drop_empty_or x))
	1795	(drop_when plus_tokens)) in
	1796	(*
	1797	print_tokens "plus tokens" plus_tokens;
	1798	Printf.printf "before minus parse\n";
	1799	*)
	1800	let minus_res =
	1801	if is_expression
	1802	then parse_one "minus" PC.minus_exp_main file minus_tokens
	1803	else parse_one "minus" PC.minus_main file minus_tokens in
	1804	(*
	1805	Unparse_ast0.unparse minus_res;
	1806	Printf.printf "before plus parse\n";
	1807	*)
	1808	let plus_res =
	1809	(* put ignore_patch_or_match with * case, which is less
	1810	constraining *)
	1811	if !Flag.sgrep_mode2 or !D.ignore_patch_or_match
	1812	then (* not actually used for anything, except context_neg *)
	1813	List.map
	1814	(Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_top_level
	1815	(Top_level.top_level false minus_res)
	1816	else
	1817	if is_expression
	1818	then parse_one "plus" PC.plus_exp_main file plus_tokens
	1819	else parse_one "plus" PC.plus_main file plus_tokens in
	1820	let plus_res = Top_level.top_level false plus_res in
	1821	(* minus code has to be CODE if the + code is CODE, otherwise
	1822	doesn't matter if + code is CODE or DECL or TOPCODE *)
	1823	let minus_res =
	1824	let any_code =
	1825	List.exists
	1826	(function x ->
	1827	match Ast0.unwrap x with Ast0.CODE _ -> true \| _ -> false)
	1828	plus_res in
	1829	if any_code
	1830	then Top_level.top_level true minus_res
	1831	else Top_level.top_level false minus_res in
	1832	let minus_res = Top_level.clean minus_res in
	1833	let plus_res = Top_level.clean plus_res in
	1834	(*
	1835	Unparse_ast0.unparse plus_res;
	1836	Printf.printf "after plus parse\n";
	1837	*)
	1838
	1839	(if not !Flag.sgrep_mode2 &&
	1840	(any_modif minus_res or any_modif plus_res) &&
	1841	not(dependencies = Ast.FailDep)
	1842	then Data.inheritable_positions := []);
	1843
	1844	Check_meta.check_meta rule_name old_metas inherited_metavars
	1845	metavars minus_res plus_res;
	1846
	1847	(more, Ast0.CocciRule ((minus_res, metavars,
	1848	(iso, dropiso, dependencies, rule_name, exists)),
	1849	(plus_res, metavars), ruletype), metavars, tokens) in
	1850
	1851	let rec collect_script_tokens = function
	1852	[(PC.EOF,_)] \| [(PC.TArobArob,_)] \| [(PC.TArob,_)] -> ""
	1853	\| (PC.TScriptData(s),_)::xs -> s^(collect_script_tokens xs)
	1854	\| toks ->
	1855	List.iter
	1856	(function x ->
	1857	Printf.printf "%s\n" (token2c x))
	1858	toks;
	1859	failwith "Malformed script rule" in
	1860
	1861	let parse_script_rule name language old_metas deps =
	1862	Lexer_script.file := file;
	1863	Lexer_script.language := language;
	1864	let get_tokens = tokens_script_all table file false lexbuf in
	1865
	1866	(* meta-variables *)
	1867	let metavars =
	1868	Data.call_in_meta
	1869	(function _ ->
	1870	get_script_metavars PC.script_meta_main table file lexbuf) in
	1871	let (metavars,script_metavars) =
	1872	List.fold_left
	1873	(function (metavars,script_metavars) ->
	1874	function
	1875	(script_var,Some(parent,var)) ->
	1876	((script_var,parent,var) :: metavars, script_metavars)
	1877	\| ((Some script_var,None),None) ->
	1878	(metavars, (name,script_var) :: script_metavars)
	1879	\| _ -> failwith "not possible")
	1880	([],[]) metavars in
	1881	let metavars = List.rev metavars in
	1882	let script_metavars = List.rev script_metavars in
	1883
	1884	Hashtbl.add Data.all_metadecls name
	1885	(List.map (function x -> Ast.MetaIdDecl(Ast.NONE,x))
	1886	script_metavars);
	1887	Hashtbl.add Lexer_cocci.rule_names name ();
	1888	(TODOHashtbl.add Lexer_cocci.all_metavariables name script_metavars;)
	1889
	1890	(*
	1891	let exists_in old_metas (py,(r,m)) =
	1892	r = "virtual" or
	1893	let test (rr,mr) x =
	1894	let (ro,vo) = Ast.get_meta_name x in
	1895	ro = rr && vo = mr in
	1896	List.exists (test (r,m)) old_metas in
	1897
	1898	List.iter
	1899	(function x ->
	1900	let meta2c (r,n) = Printf.sprintf "%s.%s" r n in
	1901	if not (exists_in old_metas x) then
	1902	failwith
	1903	(Printf.sprintf
	1904	"Script references unknown meta-variable: %s"
	1905	(meta2c(snd x))))
	1906	metavars;
	1907	*)
	1908	(* script code *)
	1909	let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
	1910	let data = collect_script_tokens tokens in
	1911	(more,
	1912	Ast0.ScriptRule(name, language, deps, metavars,
	1913	script_metavars, data),
	1914	[],tokens) in
	1915
	1916	let parse_if_script_rule k name language _ deps =
	1917	Lexer_script.file := file;
	1918	Lexer_script.language := language;
	1919	let get_tokens = tokens_script_all table file false lexbuf in
	1920
	1921	(* script code *)
	1922	let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
	1923	let data = collect_script_tokens tokens in
	1924	(more,k (name, language, deps, data),[],tokens) in
	1925
	1926	let parse_iscript_rule =
	1927	parse_if_script_rule
	1928	(function (name,language,deps,data) ->
	1929	Ast0.InitialScriptRule(name,language,deps,data)) in
	1930
	1931	let parse_fscript_rule =
	1932	parse_if_script_rule
	1933	(function (name,language,deps,data) ->
	1934	Ast0.FinalScriptRule(name,language,deps,data)) in
	1935
	1936	let do_parse_script_rule fn name l old_metas deps =
	1937	fn name l old_metas (eval_depend deps virt) in
	1938
	1939	let parse_rule old_metas starts_with_name =
	1940	let rulename =
	1941	get_rule_name PC.rule_name starts_with_name get_tokens file
	1942	"rule" in
	1943	match rulename with
	1944	Ast.CocciRulename (Some s, dep, b, c, d, e) ->
	1945	(match eval_depend dep virt with
	1946	Ast.FailDep ->
	1947	D.ignore_patch_or_match := true;
	1948	let res =
	1949	parse_cocci_rule Ast.Normal old_metas
	1950	(s, Ast.FailDep, b, c, d, e) in
	1951	D.ignore_patch_or_match := false;
	1952	res
	1953	\| dep -> parse_cocci_rule Ast.Normal old_metas (s,dep,b,c,d,e))
	1954	\| Ast.GeneratedRulename (Some s, dep, b, c, d, e) ->
	1955	(match eval_depend dep virt with
	1956	Ast.FailDep ->
	1957	D.ignore_patch_or_match := true;
	1958	Data.in_generating := true;
	1959	let res =
	1960	parse_cocci_rule Ast.Generated old_metas
	1961	(s, Ast.FailDep, b, c, d, e) in
	1962	D.ignore_patch_or_match := false;
	1963	Data.in_generating := false;
	1964	res
	1965	\| dep ->
	1966	Data.in_generating := true;
	1967	let res =
	1968	parse_cocci_rule Ast.Generated old_metas
	1969	(s,dep,b,c,d,e) in
	1970	Data.in_generating := false;
	1971	res)
	1972	\| Ast.ScriptRulename(Some s,l,deps) ->
	1973	do_parse_script_rule parse_script_rule s l old_metas deps
	1974	\| Ast.InitialScriptRulename(Some s,l,deps) ->
	1975	do_parse_script_rule parse_iscript_rule s l old_metas deps
	1976	\| Ast.FinalScriptRulename(Some s,l,deps) ->
	1977	do_parse_script_rule parse_fscript_rule s l old_metas deps
	1978	\| _ -> failwith "Malformed rule name" in
	1979
	1980	let rec loop old_metas starts_with_name =
	1981	(!Data.init_rule)();
	1982
	1983	let gen_starts_with_name more tokens =
	1984	more &&
	1985	(match List.hd (List.rev tokens) with
	1986	(PC.TArobArob,_) -> false
	1987	\| (PC.TArob,_) -> true
	1988	\| _ -> failwith "unexpected token")
	1989	in
	1990
	1991	let (more, rule, metavars, tokens) =
	1992	parse_rule old_metas starts_with_name in
	1993	let all_metas = metavars @ old_metas in
	1994
	1995	if more then
	1996	let (all_rules,all_metas) =
	1997	loop all_metas (gen_starts_with_name more tokens) in
	1998	(rule::all_rules,all_metas)
	1999	else ([rule],all_metas) in
	2000
	2001	let (all_rules,all_metas) =
	2002	loop extra_metas (x = PC.TArob) in
	2003
	2004	(List.fold_left
	2005	(function prev -> function cur -> Common.union_set cur prev)
	2006	iso_files extra_iso_files,
	2007	(* included rules first *)
	2008	List.fold_left (function prev -> function cur -> cur@prev)
	2009	all_rules (List.rev extra_rules),
	2010	List.fold_left (@) virt extra_virt (no dups allowed),
	2011	(all_metas : 'a list))
	2012	\| _ -> failwith "unexpected code before the first rule\n")
	2013	\| (false,[(PC.TArobArob,_)]) \| (false,[(PC.TArob,_)]) ->
	2014	([],([] : Ast0.parsed_rule list),[] (virtual rules), [] (all metas))
	2015	\| _ -> failwith "unexpected code before the first rule\n" in
	2016	res) in
	2017	parse_loop file
	2018
	2019	(* parse to ast0 and then convert to ast *)
	2020	let process file isofile verbose =
	2021	let extra_path = Filename.dirname file in
	2022	let (iso_files, rules, virt, _metas) = parse file in
	2023	eval_virt virt;
	2024	let std_isos =
	2025	match isofile with
	2026	None -> []
	2027	\| Some iso_file -> parse_iso_files [] [Common.Left iso_file] "" in
	2028	let global_isos = parse_iso_files std_isos iso_files extra_path in
	2029	let rules = Unitary_ast0.do_unitary rules in
	2030	let parsed =
	2031	List.map
	2032	(function
	2033	Ast0.ScriptRule (a,b,c,d,fv,e) ->
	2034	[([],Ast.ScriptRule (a,b,c,d,fv,e))]
	2035	\| Ast0.InitialScriptRule(a,b,c,d) ->
	2036	[([],Ast.InitialScriptRule (a,b,c,d))]
	2037	\| Ast0.FinalScriptRule (a,b,c,d) ->
	2038	[([],Ast.FinalScriptRule (a,b,c,d))]
	2039	\| Ast0.CocciRule
	2040	((minus, metavarsm,
	2041	(iso, dropiso, dependencies, rule_name, exists)),
	2042	(plus, metavars),ruletype) ->
	2043	let chosen_isos =
	2044	parse_iso_files global_isos
	2045	(List.map (function x -> Common.Left x) iso)
	2046	extra_path in
	2047	let chosen_isos =
	2048	(* check that dropped isos are actually available *)
	2049	(try
	2050	let iso_names =
	2051	List.map (function (_,_,nm) -> nm) chosen_isos in
	2052	let local_iso_names = reserved_names @ iso_names in
	2053	let bad_dropped =
	2054	List.find
	2055	(function dropped ->
	2056	not (List.mem dropped local_iso_names))
	2057	dropiso in
	2058	failwith
	2059	("invalid iso name " ^ bad_dropped ^ " in " ^ rule_name)
	2060	with Not_found -> ());
	2061	if List.mem "all" dropiso
	2062	then
	2063	if List.length dropiso = 1
	2064	then []
	2065	else failwith "disable all should only be by itself"
	2066	else (* drop those isos *)
	2067	List.filter
	2068	(function (_,_,nm) -> not (List.mem nm dropiso))
	2069	chosen_isos in
	2070	let dropped_isos =
	2071	match reserved_names with
	2072	"all"::others ->
	2073	(match dropiso with
	2074	["all"] -> others
	2075	\| _ ->
	2076	List.filter (function x -> List.mem x dropiso) others)
	2077	\| _ ->
	2078	failwith
	2079	"bad list of reserved names - all must be at start" in
	2080	let minus = Test_exps.process minus in
	2081	let minus = Compute_lines.compute_lines false minus in
	2082	let plus = Compute_lines.compute_lines false plus in
	2083	let is_exp =
	2084	(* only relevant to Flag.make_hrule *)
	2085	(* doesn't handle multiple minirules properly, but since
	2086	we don't really handle them in lots of other ways, it
	2087	doesn't seem very important *)
	2088	match plus with
	2089	[] -> [false]
	2090	\| p::_ ->
	2091	[match Ast0.unwrap p with
	2092	Ast0.CODE c ->
	2093	(match List.map Ast0.unwrap (Ast0.undots c) with
	2094	[Ast0.Exp e] -> true \| _ -> false)
	2095	\| _ -> false] in
	2096	let minus = Arity.minus_arity minus in
	2097	let ((metavars,minus),function_prototypes) =
	2098	Function_prototypes.process
	2099	rule_name metavars dropped_isos minus plus ruletype in
	2100	let plus = Adjust_pragmas.process plus in
	2101	(* warning! context_neg side-effects its arguments *)
	2102	let (m,p) = List.split (Context_neg.context_neg minus plus) in
	2103	Type_infer.type_infer p;
	2104	(if not (!Flag.sgrep_mode2 or dependencies = Ast.FailDep)
	2105	then Insert_plus.insert_plus m p (chosen_isos = []));
	2106	Type_infer.type_infer minus;
	2107	let (extra_meta, minus) =
	2108	match (chosen_isos,ruletype) with
	2109	(* separate case for [] because applying isos puts
	2110	some restrictions on the -+ code *)
	2111	([],_) \| (_,Ast.Generated) -> ([],minus)
	2112	\| _ -> Iso_pattern.apply_isos chosen_isos minus rule_name in
	2113	(* must be before adj *)
	2114	let minus = Commas_on_lists.process minus in
	2115	(* after iso, because iso can intro ... *)
	2116	let minus = Adjacency.compute_adjacency minus in
	2117	let minus = Comm_assoc.comm_assoc minus rule_name dropiso in
	2118	let minus =
	2119	if !Flag.sgrep_mode2 then minus
	2120	else Single_statement.single_statement minus in
	2121	let minus = Simple_assignments.simple_assignments minus in
	2122	(* has to be last, introduced AsExpr, etc *)
	2123	let minus = Get_metas.process minus in
	2124	let minus_ast =
	2125	Ast0toast.ast0toast rule_name dependencies dropped_isos
	2126	exists minus is_exp ruletype in
	2127
	2128	match function_prototypes with
	2129	None -> [(extra_meta @ metavars, minus_ast)]
	2130	\| Some mv_fp -> [(extra_meta @ metavars, minus_ast); mv_fp])
	2131	(* Ast0.CocciRule ((minus, metavarsm, (iso, dropiso, dependencies, rule_name, exists)), (plus, metavars))*)
	2132	rules in
	2133
	2134	let parsed = List.concat parsed in
	2135	let parsed = Safe_for_multi_decls.safe_for_multi_decls parsed in
	2136	let disjd = Disjdistr.disj parsed in
	2137
	2138	let (metavars,code,fvs,neg_pos,ua,pos) = Free_vars.free_vars disjd in
	2139	if !Flag_parsing_cocci.show_SP
	2140	then List.iter Pretty_print_cocci.unparse code;
	2141
	2142	let search_tokens =
	2143	Common.profile_code "get_glimpse_constants" (* for glimpse *)
	2144	(fun () -> Get_constants2.get_constants code neg_pos) in
	2145
	2146	(metavars,code,fvs,neg_pos,ua,pos,search_tokens)