<commit_before>/* NOTE: in the symbol table, local definition must replace type definition
**		in order to correctly parse local variable in functions body.
**		This is the only way to correctly handle this kind of exception,
**		that is,
**
**		typedef ... ID;
**		int f(int *p) {int ID; return (ID) * *p;}
**		If ID isn't overload, last expression is parsed as a type cast,
**		if it isn't, this a multiplication.
**
** IMPLEMENT:
**		(1) Old-parameter passing style with an exception: the first old-style
**		parameter name can't be a type name.
**		(2) GNU __attribute__ modifier, GNU ({ }) statement in expression form.
**
** HISTORY
**	1.0	2.19.99	<NAME>	First version.
**	2.0	3.22.99	<NAME>	Large simplification about declarations.
**								"register" parameters added, function pointers,
**								GCC attributes, typedef full supported.
**	2.1	4.23.99	<NAME>	GNU Statement embedded statements managed.
**		a	&x == y was analyzed as ADDROF(EQ(x, y)) corrected into the
**			right form EQ(ADDROF(x), y)
**		b	typedef struct ID ... ID; is now accepted.
**		c	{v1, v2, v3, } now accepted.
**		d	Spaced string components now accepted. Example: "Hel" "lo !".
**	3.0	6.1.99	<NAME>	Solve fully the problem of local/field/parameter
**								with the same identifier to a typedef.
**	a							const and volatile accepted for basic types
**								for fields and only-types.
**	b	10.9.99	<NAME>	Correct priorities of type algebra:
**								()() > * > []. Add typalg.c for testing it.	
*/
%{
open Cabs
let version = "Cparser V3.0b 10.9.99 <NAME>"

let parse_error _ =
	Clexer.display_error "Syntax error" (Parsing.symbol_start ()) (Parsing.symbol_end ())

(*let fatal _ =
	Clexer.display_error "fatal error" (Parsing.symbol_start ()) (Parsing.symbol_end
	())*)


(*
** Type analysis
*)
type modifier =
	BASE_SIZE of size
	| BASE_SIGN of sign
	| BASE_STORAGE of storage
	| BASE_VOLATILE
	| BASE_CONST
	| BASE_GNU_ATTR of Cabs.gnu_attrs

let apply_mod (typ, sto) modi =
	let rec mod_root typ =
		match (typ, modi) with
		(NO_TYPE, BASE_SIGN sign) -> INT (NO_SIZE, sign)
		| (NO_TYPE, BASE_SIZE size) -> INT (size, NO_SIGN)
		| (CHAR NO_SIGN, BASE_SIGN sign) -> CHAR sign
		| (INT (NO_SIZE, sign), BASE_SIZE size) -> INT (size, sign)
		| (INT (LONG, sign), BASE_SIZE LONG) -> INT (LONG_LONG, sign)
		| (INT (size, NO_SIGN), BASE_SIGN sign) -> INT (size, sign)
		| (BITFIELD (NO_SIGN, exp), BASE_SIGN sign) -> BITFIELD (sign, exp)
		| (FLOAT false, BASE_SIZE LONG) -> FLOAT true
		| (DOUBLE false, BASE_SIZE LONG) -> DOUBLE true
		| (PTR typ, _) -> PTR (mod_root typ)
		| (CONST typ, _) -> CONST (mod_root typ)
		| (VOLATILE typ, _) -> VOLATILE (mod_root typ)
		| (GNU_TYPE (attrs, typ), _) -> GNU_TYPE (attrs, mod_root typ)
		| (TYPE_LINE (f, l, t), _) -> TYPE_LINE (f, l, mod_root t)
		| _ -> raise BadModifier in
	let check_access typ =
		match typ with
		PROTO _ | OLD_PROTO _ | CONST _ | VOLATILE _ -> false
		| _ -> true in
	match modi with
	  BASE_SIGN _ -> (mod_root typ, sto)
	| BASE_SIZE _ -> (mod_root typ, sto)
	| BASE_CONST ->
		if (check_access typ) then (CONST typ, sto)
		else raise BadModifier
	| BASE_VOLATILE ->
		if (check_access typ) then (VOLATILE typ, sto)
		else raise BadModifier
	| BASE_STORAGE sto' ->
		if sto = NO_STORAGE then (typ, sto')
		else raise BadModifier
	| BASE_GNU_ATTR attrs ->
		(GNU_TYPE (attrs, typ), sto)

let apply_mods mods fty =
	List.fold_left apply_mod fty mods

let set_type tst tin =
	let rec set typ =
		match typ with
		NO_TYPE -> tst
		| PTR typ -> PTR (set typ)
		| RESTRICT_PTR typ -> RESTRICT_PTR (set typ)
		| ARRAY (typ, dim) -> ARRAY (set typ, dim)
		| PROTO (typ, pars, ell) -> PROTO (set typ, pars, ell)
		| OLD_PROTO (typ, pars, ell) -> OLD_PROTO (set typ, pars, ell)
		| CONST typ -> CONST (set typ)
		| VOLATILE typ -> VOLATILE (set typ)
		| TYPE_LINE (f, l, t) -> TYPE_LINE (f, l, set t)
		| BITFIELD (NO_SIGN, exp) ->
			(match tst with
				INT (_, sign) -> BITFIELD (sign, exp)
				| _ -> raise BadType)
		| _ -> raise BadType in
	set tin


(*
** Expression building 
*)
let smooth_expression lst =
	match lst with
		[] -> NOTHING
		| [expr] -> expr
		| _ -> COMMA (List.rev lst)
let list_expression expr =
	match expr with
		COMMA lst -> lst
		| NOTHING -> []
		| _ -> [expr]


(*** Named Building ***)
let set_name (typ : base_type) (id, typ', attr, exp) =
	(id, set_type typ typ', attr, exp)
	
let set_name_group (typ, sto) (lst : name list)
: name_group =
	(typ, sto, List.map (set_name typ) lst)
	
let set_single (typ, sto) name : single_name =
	(typ, sto, set_name typ name)

let set_data (id, typ, attr, _) ini = (id, typ, attr, ini)

let apply_qual ((t1, q1) : base_type * modifier list)
			   ((t2, q2) : base_type * modifier list)
			   : base_type * modifier list =
	((if t1 = NO_TYPE then t2 else
		if t2 = NO_TYPE then t1 else  raise BadModifier),
	List.append q1 q2)

(*** Line management ***)
let set_line (file, line) stat =
	if Clexer.linerec !Clexer.current_handle
	then Cabs.STAT_LINE (stat, file, line)
	else stat

let set_eline (file, line) expr =
	if Clexer.linerec !Clexer.current_handle
	then Cabs.EXPR_LINE (expr, file, line)
	else expr

let set_tline _type =
	if Clexer.linerec !Clexer.current_handle
	then Cabs.TYPE_LINE (Clexer.curfile (), Clexer.curline(), _type)
	else _type

%}

%token <string> IDENT
%token <string> CST_CHAR
%token <string> CST_INT
%token <string> CST_FLOAT
%token <string> CST_STRING
%token <string> NAMED_TYPE
%token <Cabs.gnu_attrs> GNU_ATTRS
%token <string> COMMENT
%token <string> LINECOMMENT

%token EOF<commit_msg>defines tokens STANDARDINCLUDE and LOCALINCLUDE<commit_after>/* NOTE: in the symbol table, local definition must replace type definition
**		in order to correctly parse local variable in functions body.
**		This is the only way to correctly handle this kind of exception,
**		that is,
**
**		typedef ... ID;
**		int f(int *p) {int ID; return (ID) * *p;}
**		If ID isn't overload, last expression is parsed as a type cast,
**		if it isn't, this a multiplication.
**
** IMPLEMENT:
**		(1) Old-parameter passing style with an exception: the first old-style
**		parameter name can't be a type name.
**		(2) GNU __attribute__ modifier, GNU ({ }) statement in expression form.
**
** HISTORY
**	1.0	2.19.99	<NAME>	First version.
**	2.0	3.22.99	<NAME>	Large simplification about declarations.
**								"register" parameters added, function pointers,
**								GCC attributes, typedef full supported.
**	2.1	4.23.99	<NAME>	GNU Statement embedded statements managed.
**		a	&x == y was analyzed as ADDROF(EQ(x, y)) corrected into the
**			right form EQ(ADDROF(x), y)
**		b	typedef struct ID ... ID; is now accepted.
**		c	{v1, v2, v3, } now accepted.
**		d	Spaced string components now accepted. Example: "Hel" "lo !".
**	3.0	6.1.99	<NAME>	Solve fully the problem of local/field/parameter
**								with the same identifier to a typedef.
**	a							const and volatile accepted for basic types
**								for fields and only-types.
**	b	10.9.99	<NAME>	Correct priorities of type algebra:
**								()() > * > []. Add typalg.c for testing it.	
*/
%{
open Cabs
let version = "Cparser V3.0b 10.9.99 <NAME>"

let parse_error _ =
	Clexer.display_error "Syntax error" (Parsing.symbol_start ()) (Parsing.symbol_end ())

(*let fatal _ =
	Clexer.display_error "fatal error" (Parsing.symbol_start ()) (Parsing.symbol_end
	())*)


(*
** Type analysis
*)
type modifier =
	BASE_SIZE of size
	| BASE_SIGN of sign
	| BASE_STORAGE of storage
	| BASE_VOLATILE
	| BASE_CONST
	| BASE_GNU_ATTR of Cabs.gnu_attrs

let apply_mod (typ, sto) modi =
	let rec mod_root typ =
		match (typ, modi) with
		(NO_TYPE, BASE_SIGN sign) -> INT (NO_SIZE, sign)
		| (NO_TYPE, BASE_SIZE size) -> INT (size, NO_SIGN)
		| (CHAR NO_SIGN, BASE_SIGN sign) -> CHAR sign
		| (INT (NO_SIZE, sign), BASE_SIZE size) -> INT (size, sign)
		| (INT (LONG, sign), BASE_SIZE LONG) -> INT (LONG_LONG, sign)
		| (INT (size, NO_SIGN), BASE_SIGN sign) -> INT (size, sign)
		| (BITFIELD (NO_SIGN, exp), BASE_SIGN sign) -> BITFIELD (sign, exp)
		| (FLOAT false, BASE_SIZE LONG) -> FLOAT true
		| (DOUBLE false, BASE_SIZE LONG) -> DOUBLE true
		| (PTR typ, _) -> PTR (mod_root typ)
		| (CONST typ, _) -> CONST (mod_root typ)
		| (VOLATILE typ, _) -> VOLATILE (mod_root typ)
		| (GNU_TYPE (attrs, typ), _) -> GNU_TYPE (attrs, mod_root typ)
		| (TYPE_LINE (f, l, t), _) -> TYPE_LINE (f, l, mod_root t)
		| _ -> raise BadModifier in
	let check_access typ =
		match typ with
		PROTO _ | OLD_PROTO _ | CONST _ | VOLATILE _ -> false
		| _ -> true in
	match modi with
	  BASE_SIGN _ -> (mod_root typ, sto)
	| BASE_SIZE _ -> (mod_root typ, sto)
	| BASE_CONST ->
		if (check_access typ) then (CONST typ, sto)
		else raise BadModifier
	| BASE_VOLATILE ->
		if (check_access typ) then (VOLATILE typ, sto)
		else raise BadModifier
	| BASE_STORAGE sto' ->
		if sto = NO_STORAGE then (typ, sto')
		else raise BadModifier
	| BASE_GNU_ATTR attrs ->
		(GNU_TYPE (attrs, typ), sto)

let apply_mods mods fty =
	List.fold_left apply_mod fty mods

let set_type tst tin =
	let rec set typ =
		match typ with
		NO_TYPE -> tst
		| PTR typ -> PTR (set typ)
		| RESTRICT_PTR typ -> RESTRICT_PTR (set typ)
		| ARRAY (typ, dim) -> ARRAY (set typ, dim)
		| PROTO (typ, pars, ell) -> PROTO (set typ, pars, ell)
		| OLD_PROTO (typ, pars, ell) -> OLD_PROTO (set typ, pars, ell)
		| CONST typ -> CONST (set typ)
		| VOLATILE typ -> VOLATILE (set typ)
		| TYPE_LINE (f, l, t) -> TYPE_LINE (f, l, set t)
		| BITFIELD (NO_SIGN, exp) ->
			(match tst with
				INT (_, sign) -> BITFIELD (sign, exp)
				| _ -> raise BadType)
		| _ -> raise BadType in
	set tin


(*
** Expression building 
*)
let smooth_expression lst =
	match lst with
		[] -> NOTHING
		| [expr] -> expr
		| _ -> COMMA (List.rev lst)
let list_expression expr =
	match expr with
		COMMA lst -> lst
		| NOTHING -> []
		| _ -> [expr]


(*** Named Building ***)
let set_name (typ : base_type) (id, typ', attr, exp) =
	(id, set_type typ typ', attr, exp)
	
let set_name_group (typ, sto) (lst : name list)
: name_group =
	(typ, sto, List.map (set_name typ) lst)
	
let set_single (typ, sto) name : single_name =
	(typ, sto, set_name typ name)

let set_data (id, typ, attr, _) ini = (id, typ, attr, ini)

let apply_qual ((t1, q1) : base_type * modifier list)
			   ((t2, q2) : base_type * modifier list)
			   : base_type * modifier list =
	((if t1 = NO_TYPE then t2 else
		if t2 = NO_TYPE then t1 else  raise BadModifier),
	List.append q1 q2)

(*** Line management ***)
let set_line (file, line) stat =
	if Clexer.linerec !Clexer.current_handle
	then Cabs.STAT_LINE (stat, file, line)
	else stat

let set_eline (file, line) expr =
	if Clexer.linerec !Clexer.current_handle
	then Cabs.EXPR_LINE (expr, file, line)
	else expr

let set_tline _type =
	if Clexer.linerec !Clexer.current_handle
	then Cabs.TYPE_LINE (Clexer.curfile (), Clexer.curline(), _type)
	else _type

%}

%token <string> IDENT
%token <string> CST_CHAR
%token <string> CST_INT
%token <string> CST_FLOAT
%token <string> CST_STRING
%token <string> NAMED_TYPE
%token <Cabs.gnu_attrs> GNU_ATTRS
%token <string> COMMENT
%token <string> LINECOMMENT
%token <string> STANDARDINCLUDE
%token <string> LOCALINCLUDE

%token EOF
{'fraction_non_alphanumeric': 0.13204335752037982, 'fraction_numerical': 0.009674818597151304, 'mean_word_length': 3.4925553319919516, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 123, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1955307', 'n_tokens_mistral': 4532, 'n_tokens_neox': 4259, 'n_words': 1385}