<commit_before>open Sast
open Ast
open Processor
open Utils
open Filepath
open Conf

module StringMap = Map.Make (String)

module StringSet = Set.Make (String)

let struct_indexes:(string, int) Hashtbl.t = Hashtbl.create 10
let predecessors:(string, string list) Hashtbl.t = Hashtbl.create 10

module SS = Set.Make(
	struct
		let compare = Pervasives.compare
		type t = datatype
	end )

type class_map = {
	field_map       : Ast.field StringMap.t;
	func_map        : Ast.func_decl StringMap.t;
	constructor_map : Ast.func_decl StringMap.t;
	reserved_map 	: sfunc_decl StringMap.t;
	cdecl 			: Ast.class_decl;
}

type env = {
	env_class_maps: class_map StringMap.t;
	env_name      : string;
	env_cmap 	  : class_map;
	env_locals    : datatype StringMap.t;
	env_parameters: Ast.formal StringMap.t;
	env_returnType: datatype;
	env_in_for    : bool;
	env_in_while  : bool;
	env_reserved  : sfunc_decl list;
}

let update_env_name env env_name = 
{
	env_class_maps = env.env_class_maps;
	env_name       = env_name;
	env_cmap 	   = env.env_cmap;
	env_locals     = env.env_locals;
	env_parameters = env.env_parameters;
	env_returnType = env.env_returnType;
	env_in_for     = env.env_in_for;
	env_in_while   = env.env_in_while;
	env_reserved   = env.env_reserved;
}

let update_call_stack env in_for in_while = 
{
	env_class_maps = env.env_class_maps;
	env_name       = env.env_name;
	env_cmap 	   = env.env_cmap;
	env_locals     = env.env_locals;
	env_parameters = env.env_parameters;
	env_returnType = env.env_returnType;
	env_in_for     = in_for;
	env_in_while   = in_while;
	env_reserved   = env.env_reserved;
}

let append_code_to_constructor fbody cname ret_type =
	let key = Hashtbl.find struct_indexes cname in 
	let init_this = [SLocal(
		ret_type,
		"this",
		SCall(	"cast", 
				[SCall("malloc", 
					[	
						SCall("sizeof", [SId("ignore", ret_type)], Datatype(Int_t), 0)
					], 
					Arraytype(Char_t, 1), 0)
				],
				ret_type,
				0
			)
		);
		SExpr(
			SAssign(
				SObjAccess(
					SId("this", ret_type),
					SId(".key", Datatype(Int_t)),
					Datatype(Int_t)
				),
				SInt_Lit(key),
				Datatype(Int_t)
			),
			Datatype(Int_t)
		)
	]
	in
	let ret_this = 
		[
			SReturn(
				SId("this", ret_type),
				ret_type
			)
		]
	in
	(* Need to check for duplicate default constructs *)
	(* Also need to add malloc around other constructors *)
	init_this @ fbody @ ret_this

let default_constructor_body cname = 
	let ret_type = Datatype(Objecttype(cname)) in
	let fbody = [] in
	append_code_to_constructor fbody cname ret_type

let default_sc cname = 
{
	sfname 			= Ast.FName (cname ^ "." ^ "constructor");
	sreturnType 	= Datatype(Objecttype(cname));
	sformals 		= [];
	sbody 			= default_constructor_body cname;
	func_type		= Sast.User;
	overrides       = false;
	source 			= "NA";
}

let default_c cname = 
{
	scope			= Ast.Public;
	fname 			= Ast.Constructor;
	returnType 		= Datatype(ConstructorType);
	formals 		= [];
	body 			= [];
	overrides 		= false;
	root_cname 		= None;
}

let process_includes filename includes classes =
	(* Bring in each include  *)
	let processInclude include_statement = 
		let file_in = open_in include_statement in
		let lexbuf = Lexing.from_channel file_in in
		let token_list = Processor.build_token_list lexbuf in
		let program = Processor.parser include_statement token_list in
		ignore(close_in file_in);
		program
	in
	let rec iterate_includes classes m = function
			[] -> classes
		| (Include h) :: t -> 
			let h = if h = "stdlib" then Conf.stdlib_path else h in
			(* Check each include against the map *)
			let realpath = Filepath.realpath h in
			if StringMap.mem realpath m then 
				iterate_includes (classes) (m) (t)
			else 
				let result = processInclude realpath in 
				match result with Program(i,c) ->
				List.iter (fun x -> print_string(Utils.string_of_include x)) i;
				iterate_includes (classes @ c) (StringMap.add realpath 1 m) (i @ t)
	in
	iterate_includes classes (StringMap.add (Filepath.realpath filename) 1 StringMap.empty) includes

let get_name cname fdecl = 
	(* We use '.' to separate types so llvm will recognize the function name and it won't conflict *)
	let params = List.fold_left (fun s -> (function Formal(t, _) -> s ^ "." ^ Utils.string_of_datatype t | _ -> "" )) "" fdecl.formals in
	let name = Utils.string_of_fname fdecl.fname in
	if name = "main" 
		then "main"
		else cname ^ "." ^ name ^ params

let get_name_without_class fdecl = 
	(* We use '.' to separate types so llvm will recognize the function name and it won't conflict *)
	let params = List.fold_left (fun s -> (function Formal(t, _) -> s ^ "." ^ Utils.string_of_datatype t | _ -> "" )) "" fdecl.formals in
	let name = Utils.string_of_fname fdecl.fname in
    name ^ params

(* Generate list of all classes to be used for semantic checking *)
let build_class_maps reserved cdecls =
	let reserved_map = List.fold_left (fun m f -> StringMap.add (Utils.string_of_fname f.sfname) f m) StringMap.empty reserved in
	let helper m (cdecl:Ast.class_decl) =  
		let fieldfun = (fun m -> (function Field(s, d, n) -> if (StringMap.mem (n) m) then raise(Exceptions.DuplicateField) else (StringMap.add n (Field(s, d, n)) m))) in
		let funcname = get_name cdecl.cname in
		let funcfun m fdecl = 
			if (StringMap.mem (funcname fdecl) m) <commit_msg>check for overridden methods takes ret type into account<commit_after>open Sast
open Ast
open Processor
open Utils
open Filepath
open Conf

module StringMap = Map.Make (String)

module StringSet = Set.Make (String)

let struct_indexes:(string, int) Hashtbl.t = Hashtbl.create 10
let predecessors:(string, string list) Hashtbl.t = Hashtbl.create 10

module SS = Set.Make(
	struct
		let compare = Pervasives.compare
		type t = datatype
	end )

type class_map = {
	field_map       : Ast.field StringMap.t;
	func_map        : Ast.func_decl StringMap.t;
	constructor_map : Ast.func_decl StringMap.t;
	reserved_map 	: sfunc_decl StringMap.t;
	cdecl 			: Ast.class_decl;
}

type env = {
	env_class_maps: class_map StringMap.t;
	env_name      : string;
	env_cmap 	  : class_map;
	env_locals    : datatype StringMap.t;
	env_parameters: Ast.formal StringMap.t;
	env_returnType: datatype;
	env_in_for    : bool;
	env_in_while  : bool;
	env_reserved  : sfunc_decl list;
}

let update_env_name env env_name = 
{
	env_class_maps = env.env_class_maps;
	env_name       = env_name;
	env_cmap 	   = env.env_cmap;
	env_locals     = env.env_locals;
	env_parameters = env.env_parameters;
	env_returnType = env.env_returnType;
	env_in_for     = env.env_in_for;
	env_in_while   = env.env_in_while;
	env_reserved   = env.env_reserved;
}

let update_call_stack env in_for in_while = 
{
	env_class_maps = env.env_class_maps;
	env_name       = env.env_name;
	env_cmap 	   = env.env_cmap;
	env_locals     = env.env_locals;
	env_parameters = env.env_parameters;
	env_returnType = env.env_returnType;
	env_in_for     = in_for;
	env_in_while   = in_while;
	env_reserved   = env.env_reserved;
}

let append_code_to_constructor fbody cname ret_type =
	let key = Hashtbl.find struct_indexes cname in 
	let init_this = [SLocal(
		ret_type,
		"this",
		SCall(	"cast", 
				[SCall("malloc", 
					[	
						SCall("sizeof", [SId("ignore", ret_type)], Datatype(Int_t), 0)
					], 
					Arraytype(Char_t, 1), 0)
				],
				ret_type,
				0
			)
		);
		SExpr(
			SAssign(
				SObjAccess(
					SId("this", ret_type),
					SId(".key", Datatype(Int_t)),
					Datatype(Int_t)
				),
				SInt_Lit(key),
				Datatype(Int_t)
			),
			Datatype(Int_t)
		)
	]
	in
	let ret_this = 
		[
			SReturn(
				SId("this", ret_type),
				ret_type
			)
		]
	in
	(* Need to check for duplicate default constructs *)
	(* Also need to add malloc around other constructors *)
	init_this @ fbody @ ret_this

let default_constructor_body cname = 
	let ret_type = Datatype(Objecttype(cname)) in
	let fbody = [] in
	append_code_to_constructor fbody cname ret_type

let default_sc cname = 
{
	sfname 			= Ast.FName (cname ^ "." ^ "constructor");
	sreturnType 	= Datatype(Objecttype(cname));
	sformals 		= [];
	sbody 			= default_constructor_body cname;
	func_type		= Sast.User;
	overrides       = false;
	source 			= "NA";
}

let default_c cname = 
{
	scope			= Ast.Public;
	fname 			= Ast.Constructor;
	returnType 		= Datatype(ConstructorType);
	formals 		= [];
	body 			= [];
	overrides 		= false;
	root_cname 		= None;
}

let process_includes filename includes classes =
	(* Bring in each include  *)
	let processInclude include_statement = 
		let file_in = open_in include_statement in
		let lexbuf = Lexing.from_channel file_in in
		let token_list = Processor.build_token_list lexbuf in
		let program = Processor.parser include_statement token_list in
		ignore(close_in file_in);
		program
	in
	let rec iterate_includes classes m = function
			[] -> classes
		| (Include h) :: t -> 
			let h = if h = "stdlib" then Conf.stdlib_path else h in
			(* Check each include against the map *)
			let realpath = Filepath.realpath h in
			if StringMap.mem realpath m then 
				iterate_includes (classes) (m) (t)
			else 
				let result = processInclude realpath in 
				match result with Program(i,c) ->
				List.iter (fun x -> print_string(Utils.string_of_include x)) i;
				iterate_includes (classes @ c) (StringMap.add realpath 1 m) (i @ t)
	in
	iterate_includes classes (StringMap.add (Filepath.realpath filename) 1 StringMap.empty) includes

let get_name cname fdecl = 
	(* We use '.' to separate types so llvm will recognize the function name and it won't conflict *)
	let params = List.fold_left (fun s -> (function Formal(t, _) -> s ^ "." ^ Utils.string_of_datatype t | _ -> "" )) "" fdecl.formals in
	let name = Utils.string_of_fname fdecl.fname in
	if name = "main" 
		then "main"
		else cname ^ "." ^ name ^ params

let get_name_without_class fdecl = 
	(* We use '.' to separate types so llvm will recognize the function name and it won't conflict *)
	let params = List.fold_left (fun s -> (function Formal(t, _) -> s ^ "." ^ Utils.string_of_datatype t | _ -> "" )) "" fdecl.formals in
	let name = Utils.string_of_fname fdecl.fname in
    let ret_type = Utils.string_of_datatype fdecl.returnType in
    ret_type ^ "." ^ name ^ "." ^ params

(* Generate list of all classes to be used for semantic checking *)
let build_class_maps reserved cdecls =
	let reserved_map = List.fold_left (fun m f -> StringMap.add (Utils.string_of_fname f.sfname) f m) StringMap.empty reserved in
	let helper m (cdecl:Ast.class_decl) =  
		let fieldfun = (fun m -> (function Field(s, d, n) -> if (StringMap.mem (n) m) then raise(Exceptions.DuplicateField) else (StringMap.add n (Field(s, d, n)) m))) in
		let funcname = get_name cdecl.cname in
		let funcfun m fdecl = 
			if (StringMap.mem (funcname fdecl) m) 
{'fraction_non_alphanumeric': 0.1009893597162591, 'fraction_numerical': 0.0018667164457718873, 'mean_word_length': 3.459009571369122, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 29, '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': '4284767', 'n_tokens_mistral': 4272, 'n_tokens_neox': 3912, 'n_words': 1028}