open Ast;;
open InterpreterStdlib;;


let default_env: environment = [Hashtbl.create 1024];;

let env_add env s v =
  match env with
  | [] -> ()
  | e1 :: _ ->  Hashtbl.add e1 s v

let env_new_lexical env = 
  let h = Hashtbl.create 16 in
  h :: env

let add_builtin s f =
  env_add default_env s (LBuiltinFunction (s, f))
let () = add_builtin "+" iadd
let () = add_builtin "-" isub
let () = add_builtin "car" car
let () = add_builtin "cdr" cdr

let make_env () = [Hashtbl.copy (List.hd default_env)]

(* the type annotations are unnecessary, but help constrain us from a
potentially more general function here *)
let rec eval_sym (env: environment) (s: string) =
  match env with
  | [] -> raise (Invalid_argument (Printf.sprintf "eval_sym: symbol %s has no value in current scope" s))
  | e :: rest ->
    match Hashtbl.find_opt e s with
    | None -> eval_sym rest s
    | Some v -> v

let rec eval_one env v = 
  match v with
  | LInt x -> LInt x
  | LDouble x -> LDouble x
  | LString s -> LString s
  | LSymbol s -> eval_sym env s
  | LNil -> LNil
  | LCons (func, args) -> eval_call env func args
  | LBuiltinFunction (n, f) -> LBuiltinFunction (n, f)
  | LFunction (n, l, f) -> LFunction (n, l, f)
  | LQuoted v -> v

(* Evaluate a list of values, without evaluating the resulting
function or macro call. Since macros and functions inherently
look similar, they share a lot of code, which is extracted here *)
and eval_list env l =
  match l with
  | LNil -> LNil
  | LCons (a, b) -> LCons (eval_one env a, eval_list env b)
  | _ -> raise (Invalid_argument "eval_list: cannot process non-list")

and eval_body env body =
  match body with
  | LNil -> LNil
  | LCons (form, LNil) -> eval_one env form
  | LCons (form, next) -> 
    ignore (eval_one env form); eval_body env next
  | _ -> LNil

and eval_apply env func args =
  let lexical_env = env_new_lexical env in
  let rec bind_one s a =
    match a with
    | LNil -> raise (Invalid_argument "not enough arguments supplied to function")
    | LCons (value, resta) ->
      env_add lexical_env s value; resta
    | _ -> raise (Invalid_argument "invalid argument list")
  and bind_args l a =
    match l with
    | LNil -> (match a with
      | LNil -> ()
      | _ -> raise (Invalid_argument "too many arguments supplied to function"))
    | LCons (LSymbol sym, LSymbol restl)->
      env_add lexical_env restl (bind_one sym a)
    | LCons (LSymbol sym, restl) ->
      bind_args restl (bind_one sym a)
    | _ -> raise (Invalid_argument "Failure while binding arguments")
  in match func with
  | LFunction (_, l, b) ->
    bind_args l args;
    eval_body lexical_env b
  | _ -> LNil
    


and eval_call env func args =
  match eval_one env func with
  | LBuiltinFunction (_, f) -> f env (eval_list env args)
  | LFunction (n, l, b) -> eval_apply env (LFunction (n, l, b)) (eval_list env args)
  | v -> raise (Invalid_argument 
        (Printf.sprintf "eval_apply: cannot call non-function object %s" (dbg_print_one v)));;

let eval_all vs =
  let env = make_env () in
  let ev v = eval_one env v in
  List.map ev vs