diff --git a/src/sail_json_backend/json.ml b/src/sail_json_backend/json.ml index 5213ce55e..08083f371 100644 --- a/src/sail_json_backend/json.ml +++ b/src/sail_json_backend/json.ml @@ -232,12 +232,55 @@ let parse_encdec i mc format = end | _ -> assert false +let extract_operands k = + let components = Hashtbl.find assembly k in + let regex = Str.regexp ".+(\\(.*\\))" in + let rec pre_filter acc = function + | [] -> List.rev acc + | hd :: tl -> + if String.trim hd = "spc" then + tl + else + pre_filter ( hd :: acc ) tl + in + let filtered_components = pre_filter [] components in + let rec extract acc = function + | [] -> List.rev acc + | hd :: tl -> + if Str.string_match regex hd 0 then + let operand = Str.matched_group 1 hd in + let trimmed_operand = + try + let comma_index = String.index operand ',' in + let trimmed = String.sub operand 0 comma_index in + debug_print ("Trimmed operand using comma: " ^ trimmed); + trimmed + with Not_found -> + debug_print ("No comma found in operand: " ^ operand); + operand + in + debug_print ("Final trimmed operand: " ^ trimmed_operand); + extract (trimmed_operand :: acc) tl + else + extract acc tl + in + let operandl = extract [] filtered_components in + let opmap = List.combine (Hashtbl.find inputs k) (Hashtbl.find sigs k) in + let operand_with_type = List.map (fun op -> + match List.find_opt (fun (name,_) -> String.equal name op) opmap with + | Some (_, t) -> (op, t) + | None -> (op, "") + ) operandl in + debug_print ("Adding to operands hashtable: " ^ k ^ " -> " ^ + String.concat ", " (List.map (fun (op, t) -> Printf.sprintf "(%s, %s)" op t) operand_with_type)); + Hashtbl.add operands k operand_with_type let add_assembly app_id p = let x = string_list_of_mpat p in begin debug_print ("assembly.add " ^ string_of_id app_id ^ " : " ^ List.hd x); - Hashtbl.add assembly (string_of_id app_id) x + Hashtbl.add assembly (string_of_id app_id) x; + extract_operands (string_of_id app_id) end let parse_assembly_mpat mp pb = @@ -396,9 +439,8 @@ let parse_funcl fcl = Hashtbl.add functions id source_code | Pat_exp (P_aux (P_app (i, pl), _), e) | Pat_when (P_aux (P_app (i, pl), _), e, _) -> debug_print ("FCL_funcl execute " ^ string_of_id i); - let operandl = List.concat (List.map string_list_of_pat pl) in - if not (String.equal (List.hd operandl) "()") then Hashtbl.add operands (string_of_id i) operandl; - Hashtbl.add executes (string_of_id i) (extract_source_code (Ast_util.exp_loc e)) + let source_code = extract_source_code (Ast_util.exp_loc e) in + Hashtbl.add executes (string_of_id i) source_code | _ -> () end | _ -> debug_print "FCL_funcl other" @@ -536,7 +578,7 @@ let default_operand optional opt_operand = let json_of_operand k op = debug_print ("json_of_operand " ^ k ^ ":" ^ op); - let opmap = List.combine (Hashtbl.find operands k) (Hashtbl.find sigs k) in + let opmap = Hashtbl.find operands k in let opplus = remove_identity_funcs op in let opname = List.hd (String.split_on_char ',' opplus) in let optional, opt_operand = optional_operand k op in @@ -555,9 +597,9 @@ let json_of_operands k = | Some ops -> String.concat "," (List.map - (fun op -> json_of_operand k op) + (fun (op, _) -> json_of_operand k op) (List.filter - (fun s -> not (String.equal s "(" || String.equal s ")" || String.equal s "spc" || String.equal s "sep")) + (fun (s, _) -> not (String.equal s "(" || String.equal s ")" || String.equal s "spc" || String.equal s "sep")) ops ) ) @@ -595,7 +637,7 @@ let rec string_of_sizeof_field k f = ) else begin (* match operand names to function signature types *) - let opmap = List.combine (Hashtbl.find operands k) (Hashtbl.find sigs k) in + let opmap = Hashtbl.find operands k in begin (* find matching operand type *) match List.assoc_opt f opmap with @@ -746,7 +788,7 @@ let defs { defs; _ } = debug_print "DESCRIPTIONS"; Hashtbl.iter (fun k v -> debug_print (k ^ ":" ^ v)) descriptions; debug_print "OPERANDS"; - Hashtbl.iter (fun k v -> debug_print (k ^ ":" ^ Util.string_of_list ", " (fun x -> x) v)) operands; + Hashtbl.iter (fun k v -> debug_print (k ^ ":" ^ Util.string_of_list ", " (fun (op, t) -> "(" ^ op ^ ", " ^ t ^ ")") v)) operands; debug_print "ENCODINGS"; Hashtbl.iter (fun k v -> debug_print (k ^ ":" ^ Util.string_of_list ", " (fun x -> x) v)) encodings; debug_print "ASSEMBLY";