(*
 * Emulation of (a subset of) the `env` module currently used by Binaryen,
 * so that we can run modules generated by Binaryen. This is a stopgap until
 * we have agreement on what libc should look like.
 *)

(* MODIFIED by Conrad Watt *)

open Values
open Types
open Instance


let error msg = raise (Eval.Crash (Source.no_region, msg))

let type_error v t =
  error
    ("type error, expected " ^ string_of_value_type t ^
     ", got (can't stringify type)" (*^ string_of_value_type (type_of v) *))

let empty = function
  | [] -> ()
  | vs -> error "type error, too many arguments"

let single = function
  | [] -> error "type error, missing arguments"
  | [v] -> v
  | vs -> error "type error, too many arguments"

let int = function
  | InterpreterAux.Wasm.ConstInt32 i -> Int32.to_int i
  | v -> type_error v I32Type

let print_char v =
  Printf.printf "%c" (char_of_int (int v))
(*
let memset s i' vs =
	let i = Big_int.int_of_big_int (InterpreterAux.Arith.integer_of_nat i') in
	let memory = (List.nth (InterpreterAux.Wasm.mem s) i).Memory.content in
	match vs with
	| [InterpreterAux.Wasm.ConstInt32 dest'; InterpreterAux.Wasm.ConstInt32 v'; InterpreterAux.Wasm.ConstInt32 n'] ->
	  let dest = Int32.to_int dest' in
		let v = Int32.to_int v' in
		let n = Int32.to_int n' in
    for off = 0 to (n-1) do
      Bigarray.Array1.set memory (dest+off) v
	  done;
		(s, [InterpreterAux.Wasm.ConstInt32 dest'])
	| _ -> error "memset wrong args"

let memcpy s i' vs =
	let i = Big_int.int_of_big_int (InterpreterAux.Arith.integer_of_nat i') in
	let memory = (List.nth (InterpreterAux.Wasm.mem s) i).Memory.content in
	match vs with
	| [InterpreterAux.Wasm.ConstInt32 dest'; InterpreterAux.Wasm.ConstInt32 src'; InterpreterAux.Wasm.ConstInt32 n'] ->
    let dest = Int32.to_int dest' in
    let src = Int32.to_int src' in
    let n = Int32.to_int n' in
    for off = 0 to (n-1) do
      let v = Bigarray.Array1.get memory (src+off) in
      Bigarray.Array1.set memory (dest+off) v
	  done;
		(s, [InterpreterAux.Wasm.ConstInt32 dest'])
	| _ -> error "memcpy wrong args"
*)
let putchar (FuncType (_, out)) s vs =
  print_char (single vs);
  flush_all ();
  (s, List.map Ast_convert.default_value out)

let default s vs = error "called stub!"

let abort vs =
  empty vs;
  print_endline "Abort!";
  exit (-1)

let exit vs =
  exit (int (single vs))


let lookup name t =
  match Utf8.encode name, t with
	| "printf", ExternalFuncType t -> ExternalFunc (HostFunc (t, ImplWrapperTypes.Hf default))
(*
	| "memset", ExternalFuncType ((FuncType ([I32Type;I32Type;I32Type], [I32Type])) as t) ->
		  ExternalFunc (HostFunc (t, ImplWrapperTypes.Hf memset))
	| "memcpy", ExternalFuncType ((FuncType ([I32Type;I32Type;I32Type], [I32Type])) as t) ->
		  ExternalFunc (HostFunc (t, ImplWrapperTypes.Hf memcpy))
*)
	| "putchar", ExternalFuncType ((FuncType ([I32Type], [I32Type])) as t) ->
		  ExternalFunc (HostFunc (t, ImplWrapperTypes.Hf (putchar t))) (*
  | "abort", ExternalFuncType t -> ExternalFunc (HostFunc (t, abort))
  | "exit", ExternalFuncType t -> ExternalFunc (HostFunc (t, exit)) *)
  | _ -> raise Not_found
