diff options
Diffstat (limited to 'src/lem_interp')
| -rw-r--r-- | src/lem_interp/Interp_interface.lem | 44 | ||||
| -rw-r--r-- | src/lem_interp/interp_inter_imp.lem | 40 |
2 files changed, 61 insertions, 23 deletions
diff --git a/src/lem_interp/Interp_interface.lem b/src/lem_interp/Interp_interface.lem index 0767ea79..136078aa 100644 --- a/src/lem_interp/Interp_interface.lem +++ b/src/lem_interp/Interp_interface.lem @@ -4,49 +4,47 @@ type read_kind = Interp.read_kind type write_kind = Interp.write_kind type barrier_kind = Interp.barrier_kind +type word8 = nat (* bounded at a byte, for when lem supports it*) + type value = -| Bitvector of list nat (*Always 0 or 1; should this be a Word.bitSequence? *) -| Bytevector of list (list nat) (* Should this be a list of Word.bitSequence? *) +| Bitvector of list bool (* For register accesses *) +| Bytevector of list word8 (* For memory accesses *) | Unknown type instruction_state = Interp.stack type context = Interp.top_level -type reg_name = Interp.reg_form (*for now...*) +type reg_name = +| Reg of string (*Name of the register, accessing the entire register*) +| Reg_slice of string * integer * integer (*Name of the register, accessing from the first to second integer*) +| Reg_field of string * string * integer * integer (*Name of the register, name of the field of the register accessed, the index range of the field*) +| Reg_f_slice of string * string * integer * integer * integer * integer (* Same as above but only accessing from the third to the fourth integer of the field *) type outcome = | Read_mem of read_kind * value * (value -> instruction_state) | Write_mem of write_kind * value * value * (bool -> instruction_state) | Barrier of barrier_kind * instruction_state -| Read_reg of reg_name * (value -> instruction_state) (*What about slicing?*) +| Read_reg of reg_name * (value -> instruction_state) | Write_reg of reg_name * value * instruction_state | Nondet_choice of list instruction_state | Internal of instruction_state | Done | Error of string +type event = +| E_read_mem of read_kind * value +| E_write_mem of write_kind * value +| E_barrier of barrier_kind +| E_read_reg of reg_name +| E_write_reg of reg_name +(*Should multiple memory accesses be represented with a special form to denote this or potentially merged into one read or left in place*) + + val build_context : Interp.defs Interp.tannot -> context val initial_instruction_state : context -> string -> value -> instruction_state type interp_mode = <| eager_eval : bool |> -val interp : instruction_state -> interp_mode -> outcome - -val interp_exhaustive : instruction_state -> list outcome (*not sure what event was ment to be*) - -val intern_value : value -> Interp.value -val extern_value : Interp.value -> value - -let build_context defs = Interp.to_top_env defs - -let intern_value v = match v with - | Bitvector bs -> Interp.V_vector 0 true (List.map (fun | 0 -> (Interp.V_lit (Interp_ast.L_aux Interp_ast.L_zero Interp_ast.Unknown)) - | _ -> (Interp.V_lit (Interp_ast.L_aux Interp_ast.L_one Interp_ast.Unknown))) bs) - | Unknown -> Interp.V_unknown +val interp : interp_mode -> instruction_state -> outcome -let extern_value v = match v with - | Interp.V_vector _ true bits -> Bitvector (List.map (fun | Interp.V_lit (Interp_ast.L_aux Interp_ast.L_zero _) -> 0 - | _ -> 1) bits) - | _ -> Unknown +val interp_exhaustive : instruction_state -> list event -let initial_instruction_state top_level main arg = - Interp.Frame Nothing (E_aux (E_app (Id_aux (Id main) Interp_ast.Unknown) [ intern_value arg ]) (Interp_ast.Unknown, Nothing)) top_level [] Interp.emem diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem new file mode 100644 index 00000000..8b7fdec3 --- /dev/null +++ b/src/lem_interp/interp_inter_imp.lem @@ -0,0 +1,40 @@ +import Interp +import Interp_lib +open import Interp_interface + +val intern_value : value -> Interp.value +val extern_value : Interp.value -> value + +let build_context defs = Interp.to_top_env defs + +let intern_value v = match v with + | Bitvector bs -> Interp.V_vector 0 true (List.map (fun | 0 -> (Interp.V_lit (Interp_ast.L_aux Interp_ast.L_zero Interp_ast.Unknown)) + | _ -> (Interp.V_lit (Interp_ast.L_aux Interp_ast.L_one Interp_ast.Unknown))) bs) + | Unknown -> Interp.V_unknown +end + +let extern_value v = match v with + | Interp.V_vector _ true bits -> Bitvector (List.map (fun | Interp.V_lit (Interp_ast.L_aux Interp_ast.L_zero _) -> 0 + | _ -> 1) bits) + | _ -> Unknown +end + +let initial_instruction_state top_level main arg = + Interp.Frame Nothing (E_aux (E_app (Id_aux (Id main) Interp_ast.Unknown) [ intern_value arg ]) (Interp_ast.Unknown, Nothing)) top_level [] Interp.emem + +let interp mode i_state = + match Interp.resume mode i_state None with + | Interp.Value _ -> Done + | Interp.Error l msg -> Error msg (*Todo, add the l information the string format*) + | Interp.Action a next_state -> + match a with + | Interp.Read_reg reg_form slice -> Read_reg reg_form (fun v -> Interp.add_answer_to_stack (intern_value v) next_state) + | Interp.Write_reg reg_form slice value -> Write_reg reg_form (extern_value value) next_state + | Interp.Read_mem (Id_aux (Id i) _) value slice + (*Need to lookup the Mem function used to determine appropriate value, and possible appropriate read_kind *) + -> Read_mem Interp.Read_plain (extern_value value) (fun v -> Interp.add_answer_to_stack (intern_value v) next_state) + | Interp.Write_mem (Id_aux (id i) _) loc_val slice write_val -> + Write_mem Interp.Write_plain (extern_value loc_val) (extern_value write_val) next_state + | Interp.Call_extern id value -> (*Connect here to a list of external functions*) + end + end |
