diff options
Diffstat (limited to 'src/bitfield.ml')
| -rw-r--r-- | src/bitfield.ml | 27 |
1 files changed, 11 insertions, 16 deletions
diff --git a/src/bitfield.ml b/src/bitfield.ml index 5b0a73b0..46c18735 100644 --- a/src/bitfield.ml +++ b/src/bitfield.ml @@ -52,17 +52,12 @@ module Big_int = Nat_big_num open Initial_check open Ast +open Ast_defs open Ast_util let bitvec size order = Printf.sprintf "bitvector(%i, %s)" size (string_of_order order) -let rec combine = function - | [] -> Defs [] - | (Defs defs) :: ast -> - let (Defs defs') = combine ast in - Defs (defs @ defs') - let newtype name size order = let chunks_64 = Util.list_init (size / 64) (fun i -> Printf.sprintf "%s_chunk_%i : bitvector(64, %s)" name i (string_of_order order)) @@ -75,7 +70,7 @@ let newtype name size order = chunk_rem :: List.rev chunks_64 in let nt = Printf.sprintf "struct %s = {\n %s }" name (Util.string_of_list ",\n " (fun x -> x) chunks) in - ast_of_def_string nt + defs_of_string nt let rec translate_indices hi lo = if hi / 64 = lo / 64 then @@ -97,7 +92,7 @@ let constructor name order start stop = "}" ] in - combine [ast_of_def_string constructor_val; ast_of_def_string constructor_function] + List.concat [defs_of_string constructor_val; defs_of_string constructor_function] (* For every index range, create a getter and setter *) let index_range_getter name field order start stop = @@ -108,7 +103,7 @@ let index_range_getter name field order start stop = Printf.sprintf "v.%s_chunk_%i[%i .. %i]" name chunk start stop in let irg_function = Printf.sprintf "function _get_%s_%s v = %s" name field (Util.string_of_list " @ " body indices) in - combine [ast_of_def_string irg_val; ast_of_def_string irg_function] + List.concat [defs_of_string irg_val; defs_of_string irg_function] let index_range_setter name field order start stop = let indices = translate_indices start stop in @@ -127,7 +122,7 @@ let index_range_setter name field order start stop = "}" ] in - combine [ast_of_def_string irs_val; ast_of_def_string irs_function] + List.concat [defs_of_string irs_val; defs_of_string irs_function] let index_range_update name field order start stop = let indices = translate_indices start stop in @@ -145,10 +140,10 @@ let index_range_update name field order start stop = ] in let iru_overload = Printf.sprintf "overload update_%s = {_update_%s_%s}" field name field in - combine [ast_of_def_string iru_val; ast_of_def_string iru_function; ast_of_def_string iru_overload] + List.concat [defs_of_string iru_val; defs_of_string iru_function; defs_of_string iru_overload] let index_range_overload name field order = - ast_of_def_string (Printf.sprintf "overload _mod_%s = {_get_%s_%s, _set_%s_%s}" field name field name field) + defs_of_string (Printf.sprintf "overload _mod_%s = {_get_%s_%s, _set_%s_%s}" field name field name field) let index_range_accessor (eval, typ_error) name field order (BF_aux (bf_aux, l)) = let getter n m = index_range_getter name field order (Big_int.to_int n) (Big_int.to_int m) in @@ -161,10 +156,10 @@ let index_range_accessor (eval, typ_error) name field order (BF_aux (bf_aux, l)) match bf_aux with | BF_single n -> let n = const_fold n in - combine [getter n n; setter n n; update n n; overload] + List.concat [getter n n; setter n n; update n n; overload] | BF_range (n, m) -> let n, m = const_fold n, const_fold m in - combine [getter n m; setter n m; update n m; overload] + List.concat [getter n m; setter n m; update n m; overload] | BF_concat _ -> failwith "Unimplemented" let field_accessor (eval, typ_error) name order (id, ir) = @@ -175,5 +170,5 @@ let macro (eval, typ_error) id size order ranges = let ranges = (mk_id "bits", BF_aux (BF_range (nconstant (Big_int.of_int (size - 1)), nconstant (Big_int.of_int 0)), Parse_ast.Unknown)) :: ranges in - combine ([newtype name size order; constructor name order (size - 1) 0] - @ List.map (field_accessor (eval, typ_error) name order) ranges) + List.concat ([newtype name size order; constructor name order (size - 1) 0] + @ List.map (field_accessor (eval, typ_error) name order) ranges) |