Merge branch 'sail2' into rmem_interpreter

1 files changed, 24 insertions, 13 deletions

diff --git a/src/bitfield.ml b/src/bitfield.ml
index afdd5baf..1f64adbd 100644
--- a/src/bitfield.ml
+++ b/src/bitfield.ml
@@ -75,7 +75,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 order nt
+  ast_of_def_string nt
 
 let rec translate_indices hi lo =
   if hi / 64 = lo / 64 then
@@ -97,7 +97,7 @@ let constructor name order start stop =
                      "}"
     ]
   in
-  combine [ast_of_def_string order constructor_val; ast_of_def_string order constructor_function]
+  combine [ast_of_def_string constructor_val; ast_of_def_string constructor_function]
 
 (* For every index range, create a getter and setter *)
 let index_range_getter name field order start stop =
@@ -108,7 +108,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 order irg_val; ast_of_def_string order irg_function]
+  combine [ast_of_def_string irg_val; ast_of_def_string irg_function]
 
 let index_range_setter name field order start stop =
   let indices = translate_indices start stop in
@@ -127,7 +127,7 @@ let index_range_setter name field order start stop =
                      "}"
     ]
   in
-  combine [ast_of_def_string order irs_val; ast_of_def_string order irs_function]
+  combine [ast_of_def_string irs_val; ast_of_def_string irs_function]
 
 let index_range_update name field order start stop =
   let indices = translate_indices start stop in
@@ -145,24 +145,35 @@ 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 order iru_val; ast_of_def_string order iru_function; ast_of_def_string order iru_overload]
+  combine [ast_of_def_string iru_val; ast_of_def_string iru_function; ast_of_def_string iru_overload]
 
 let index_range_overload name field order =
-  ast_of_def_string order (Printf.sprintf "overload _mod_%s = {_get_%s_%s, _set_%s_%s}" field name field name field)
+  ast_of_def_string (Printf.sprintf "overload _mod_%s = {_get_%s_%s, _set_%s_%s}" field name field name field)
 
-let index_range_accessor name field order (BF_aux (bf_aux, l)) =
+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
   let setter n m = index_range_setter name field order (Big_int.to_int n) (Big_int.to_int m) in
   let update n m = index_range_update name field order (Big_int.to_int n) (Big_int.to_int m) in
   let overload = index_range_overload name field order in
+  let const_fold nexp = match eval nexp with
+      | Some v -> v
+      | None -> typ_error l (Printf.sprintf "Non-constant index for field %s" field) in
   match bf_aux with
-  | BF_single n -> combine [getter n n; setter n n; update n n; overload]
-  | BF_range (n, m) -> combine [getter n m; setter n m; update n m; overload]
+  | BF_single n ->
+        let n = const_fold n in
+        combine [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]
   | BF_concat _ -> failwith "Unimplemented"
 
-let field_accessor name order (id, ir) = index_range_accessor name (string_of_id id) order ir
+let field_accessor (eval, typ_error) name order (id, ir) =
+  index_range_accessor (eval, typ_error) name (string_of_id id) order ir
 
-let macro id size order ranges =
+let macro (eval, typ_error) id size order ranges =
   let name = string_of_id id in
-  let ranges = (mk_id "bits", BF_aux (BF_range (Big_int.of_int (size - 1), 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 name 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)