<commit_before>open Common

open Ast_cpp

module Ast = Ast_cpp
module Flag = Flag_parsing_cpp

(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
let pr2, pr2_once = Common2.mk_pr2_wrappers Flag.verbose_parsing 

let warning s v = 
  if !Flag.verbose_parsing 
  then Common2.warning ("PARSING: " ^ s) v
  else v

exception Semantic of string * Ast_cpp.tok

(*****************************************************************************)
(* Parse helpers functions *)
(*****************************************************************************)

(*-------------------------------------------------------------------------- *)
(* Type related *)
(*-------------------------------------------------------------------------- *)

type shortLong = Short | Long | LongLong
    
(* note: have a full_info: parse_info list; to remember ordering
 * between storage, qualifier, type? well this info is already in
 * the Ast_c.info, just have to sort them to get good order 
 *)
type decl = { 
  storageD: storagebis wrap;
  typeD: (sign option * shortLong option * typeCbis option) wrap;
  qualifD: typeQualifier;
  inlineD: bool wrap;
} 

let nullDecl = {
  storageD = NoSto, noii;
  typeD = (None, None, None), noii;
  qualifD = Ast.nQ;
  inlineD = false, noii;
}

let addStorageD (x, ii) decl  =
  match decl with
  | {storageD = (NoSto,[]); _} -> { decl with storageD = (x, [ii]) }
  | {storageD = (y, _ii2); _} -> 
      if x = y 
      then decl +> warning "duplicate storage classes"
      else raise (Semantic ("multiple storage classes", ii))

let addInlineD ii decl =
  match decl with
  | {inlineD = (false,[]); _} -> { decl with inlineD=(true,[ii])}
  | {inlineD = (true, _ii2); _} -> decl +> warning "duplicate inline"
  | _ -> raise Impossible


let addTypeD ty decl =
  match ty, decl with
  | (Left3 Signed,_ii), {typeD = ((Some Signed,  _b,_c),_ii2); _} -> 
      decl +> warning "duplicate 'signed'"
  | (Left3 UnSigned,_ii), {typeD = ((Some UnSigned,_b,_c),_ii2); _} -> 
      decl +> warning "duplicate 'unsigned'"
  | (Left3 _,ii),        {typeD = ((Some _,_b,_c),_ii2); _} -> 
      raise (Semantic ("both signed and unsigned specified", List.hd ii))
  | (Left3 x,ii),        {typeD = ((None,b,c),ii2); _} -> 
      { decl with typeD = (Some x,b,c),ii @ ii2}
  | (Middle3 Short,_ii),  {typeD = ((_a,Some Short,_c),_ii2); _} -> 
      decl +> warning "duplicate 'short'"

      
  (* gccext: long long allowed *)
  | (Middle3 Long,ii),   {typeD = ((a,Some Long,c),ii2); _}-> 
      { decl with typeD = (a, Some LongLong, c),ii@ii2 }
  | (Middle3 Long,_ii),  {typeD = ((_a,Some LongLong,_c),_ii2); _} -> 
      decl +> warning "triplicate 'long'"

  | (Middle3 _,ii),     {typeD = ((_a,Some _,_c),_ii2); _} -> 
      raise (Semantic ("both long and short specified", List.hd ii))
  | (Middle3 x,ii),      {typeD = ((a,None,c),ii2); _} -> 
      { decl with typeD = (a, Some x,c),ii@ii2}

  | (Right3 _t,ii),     {typeD = ((_a,_b,Some _),_ii2); _} -> 
      raise (Semantic ("two or more data types", List.hd ii))
  | (Right3 t,ii),       {typeD = ((a,b,None),ii2); _}   -> 
      { decl with typeD = (a,b, Some t),ii@ii2}


let addQualif tq1 tq2 =
  match tq1, tq2 with
  | {const=Some _; _},   {const=Some _; _} -> 
      tq2 +> warning "duplicate 'const'"
  | {volatile=Some _; _}, {volatile=Some _; _} -> 
      tq2 +> warning "duplicate 'volatile'"
  | {const=Some x; _},   _ -> 
      { tq2 with const = Some x}
  | {volatile=Some x; _}, _ -> 
      { tq2 with volatile = Some x}
  | _ -> Common2.internal_error "there is no noconst or novolatile keyword"

let addQualifD qu qu2 = 
  { qu2 with qualifD = addQualif qu qu2.qualifD }


(*-------------------------------------------------------------------------- *)
(* Declaration/Function related *)
(*-------------------------------------------------------------------------- *)

(* stdC: type section, basic integer types (and ritchie)
 * To understand the code, just look at the result (right part of the PM) 
 * and go back.
 *)
let type_and_storage_from_decl  
  {storageD = (st,iist); 
  qualifD = qu; 
  typeD = (ty,iit); 
  inlineD = (inline,iinl);
  } = 
 (qu,
   (match ty with 
 | (None, None, None)     -> warning "type defaults to 'int'" (defaultInt, noii)
 | (None, None, Some t)   -> (t, iit)<commit_msg>* lang_cpp/parsing/parser_cpp_mly_helper.ml: more strict on missing return type<commit_after>open Common

open Ast_cpp

module Ast = Ast_cpp
module Flag = Flag_parsing_cpp

(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
let pr2, pr2_once = Common2.mk_pr2_wrappers Flag.verbose_parsing 

let warning s v = 
  if !Flag.verbose_parsing 
  then Common2.warning ("PARSING: " ^ s) v
  else v

exception Semantic of string * Ast_cpp.tok

(*****************************************************************************)
(* Parse helpers functions *)
(*****************************************************************************)

(*-------------------------------------------------------------------------- *)
(* Type related *)
(*-------------------------------------------------------------------------- *)

type shortLong = Short | Long | LongLong
    
(* note: have a full_info: parse_info list; to remember ordering
 * between storage, qualifier, type? well this info is already in
 * the Ast_c.info, just have to sort them to get good order 
 *)
type decl = { 
  storageD: storagebis wrap;
  typeD: (sign option * shortLong option * typeCbis option) wrap;
  qualifD: typeQualifier;
  inlineD: bool wrap;
} 

let nullDecl = {
  storageD = NoSto, noii;
  typeD = (None, None, None), noii;
  qualifD = Ast.nQ;
  inlineD = false, noii;
}

let addStorageD (x, ii) decl  =
  match decl with
  | {storageD = (NoSto,[]); _} -> { decl with storageD = (x, [ii]) }
  | {storageD = (y, _ii2); _} -> 
      if x = y 
      then decl +> warning "duplicate storage classes"
      else raise (Semantic ("multiple storage classes", ii))

let addInlineD ii decl =
  match decl with
  | {inlineD = (false,[]); _} -> { decl with inlineD=(true,[ii])}
  | {inlineD = (true, _ii2); _} -> decl +> warning "duplicate inline"
  | _ -> raise Impossible


let addTypeD ty decl =
  match ty, decl with
  | (Left3 Signed,_ii), {typeD = ((Some Signed,  _b,_c),_ii2); _} -> 
      decl +> warning "duplicate 'signed'"
  | (Left3 UnSigned,_ii), {typeD = ((Some UnSigned,_b,_c),_ii2); _} -> 
      decl +> warning "duplicate 'unsigned'"
  | (Left3 _,ii),        {typeD = ((Some _,_b,_c),_ii2); _} -> 
      raise (Semantic ("both signed and unsigned specified", List.hd ii))
  | (Left3 x,ii),        {typeD = ((None,b,c),ii2); _} -> 
      { decl with typeD = (Some x,b,c),ii @ ii2}
  | (Middle3 Short,_ii),  {typeD = ((_a,Some Short,_c),_ii2); _} -> 
      decl +> warning "duplicate 'short'"

      
  (* gccext: long long allowed *)
  | (Middle3 Long,ii),   {typeD = ((a,Some Long,c),ii2); _}-> 
      { decl with typeD = (a, Some LongLong, c),ii@ii2 }
  | (Middle3 Long,_ii),  {typeD = ((_a,Some LongLong,_c),_ii2); _} -> 
      decl +> warning "triplicate 'long'"

  | (Middle3 _,ii),     {typeD = ((_a,Some _,_c),_ii2); _} -> 
      raise (Semantic ("both long and short specified", List.hd ii))
  | (Middle3 x,ii),      {typeD = ((a,None,c),ii2); _} -> 
      { decl with typeD = (a, Some x,c),ii@ii2}

  | (Right3 _t,ii),     {typeD = ((_a,_b,Some _),_ii2); _} -> 
      raise (Semantic ("two or more data types", List.hd ii))
  | (Right3 t,ii),       {typeD = ((a,b,None),ii2); _}   -> 
      { decl with typeD = (a,b, Some t),ii@ii2}


let addQualif tq1 tq2 =
  match tq1, tq2 with
  | {const=Some _; _},   {const=Some _; _} -> 
      tq2 +> warning "duplicate 'const'"
  | {volatile=Some _; _}, {volatile=Some _; _} -> 
      tq2 +> warning "duplicate 'volatile'"
  | {const=Some x; _},   _ -> 
      { tq2 with const = Some x}
  | {volatile=Some x; _}, _ -> 
      { tq2 with volatile = Some x}
  | _ -> Common2.internal_error "there is no noconst or novolatile keyword"

let addQualifD qu qu2 = 
  { qu2 with qualifD = addQualif qu qu2.qualifD }


(*-------------------------------------------------------------------------- *)
(* Declaration/Function related *)
(*-------------------------------------------------------------------------- *)

(* stdC: type section, basic integer types (and ritchie)
 * To understand the code, just look at the result (right part of the PM) 
 * and go back.
 *)
let type_and_storage_from_decl  
  {storageD = (st,iist); 
  qualifD = qu; 
  typeD = (ty,iit); 
  inlineD = (inline,iinl);
  } = 
 (qu,
   (match ty with 
 | (None, None, None)     -> 
   (* mine (originally default to int, but this looks like bad style) *)
   raise (Semantic ("no type (could default to 'int')", List.hd iist))
 | (None, None, Some t)   -> (t, iit)
{'fraction_non_alphanumeric': 0.2741450373175894, 'fraction_numerical': 0.010025621031525008, 'mean_word_length': 2.5669447755264203, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 65, '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': '2127208', 'n_tokens_mistral': 3041, 'n_tokens_neox': 2912, 'n_words': 828}