Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix: address build failure with older ocaml versions (< 4.13) #23

Closed
wants to merge 1 commit into from
Closed

fix: address build failure with older ocaml versions (< 4.13) #23

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 24 additions & 8 deletions src/sail_json_backend/json.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,9 @@ open Ast
open Ast_defs
open Ast_util

external length : string -> int = "%string_length"
external unsafe_get : string -> int -> char = "%string_unsafe_get"

let debug_enabled =
match Sys.getenv_opt "SAIL_DEBUG" with Some value -> value = "1" || int_of_string_opt value = Some 1 | None -> false

Expand All @@ -91,9 +94,23 @@ let mappings = Hashtbl.create 997

let debug_print ?(printer = prerr_endline) message = if debug_enabled then printer message else ()

(* excerpt taken from ocaml/stdlib/string.ml *)
let starts_with ~prefix s =
let len_s = length s and len_pre = length prefix in
let rec aux i = if i = len_pre then true else if unsafe_get s i <> unsafe_get prefix i then false else aux (i + 1) in
len_s >= len_pre && aux 0

(* excerpt taken from ocaml/stdlib/string.ml *)
let ends_with ~suffix s =
let len_s = length s and len_suf = length suffix in
let diff = len_s - len_suf in
let rec aux i =
if i = len_suf then true else if unsafe_get s (diff + i) <> unsafe_get suffix i then false else aux (i + 1)
in
diff >= 0 && aux 0

let dequote qs =
if String.starts_with ~prefix:"\"" qs && String.ends_with ~suffix:"\"" qs then
List.hd (List.tl (String.split_on_char '"' qs))
if starts_with ~prefix:"\"" qs && ends_with ~suffix:"\"" qs then List.hd (List.tl (String.split_on_char '"' qs))
else qs

let string_of_arg = function E_aux (E_id id, _) -> "\"" ^ string_of_id id ^ "\"" | exp -> "exp " ^ string_of_exp exp
Expand Down Expand Up @@ -394,8 +411,7 @@ let identity_funcs =
]

let defunction f n =
if String.starts_with ~prefix:(n ^ "(") f then
String.sub f (String.length n + 1) (String.length f - String.length n - 2)
if starts_with ~prefix:(n ^ "(") f then String.sub f (String.length n + 1) (String.length f - String.length n - 2)
else f

let remove_identity_funcs op =
Expand Down Expand Up @@ -529,10 +545,10 @@ let extract_func_arg s = List.hd (String.split_on_char ')' (List.hd (List.tl (St
let rec string_of_sizeof_field k f =
debug_print ("string_of_sizeof_field " ^ k ^ ":" ^ f);

if String.starts_with ~prefix:"0b" f then (* binary literal "0b..." *)
if starts_with ~prefix:"0b" f then (* binary literal "0b..." *)
string_of_int (String.length f - 2)
else if String.contains f '(' then
if String.starts_with ~prefix:"bits(" f then (* bits(n) *)
if starts_with ~prefix:"bits(" f then (* bits(n) *)
extract_func_arg f
else (
let op_func = List.hd (String.split_on_char '(' f) in
Expand All @@ -549,7 +565,7 @@ let rec string_of_sizeof_field k f =
(* try to drill down to a base type *)
let bt = basetype t in
if bt = "bool" then "1"
else if String.starts_with ~prefix:"bits(" bt then extract_func_arg bt
else if starts_with ~prefix:"bits(" bt then extract_func_arg bt
else begin
debug_print ("unfamiliar base type " ^ bt);
"72" (* TODO: needs work *)
Expand Down Expand Up @@ -649,7 +665,7 @@ let rec explode_mnemonics asm =
else if String.equal (List.hd asm) "spc" then ["" :: List.tl asm]
else (
let tails = explode_mnemonics (List.tl asm) in
if String.ends_with ~suffix:")" (List.hd asm) then begin
if ends_with ~suffix:")" (List.hd asm) then begin
debug_print (extract_func_arg (List.hd asm));
let heads = Hashtbl.find_all mappings (List.hd (String.split_on_char '(' (List.hd asm))) in
let found =
Expand Down
Loading