open Imptypes;;

type vartyp =
        Undeclared
      | VTyp of (ityp * bool)

type typctx = varname -> vartyp

type cmdtyp = TypCtx of typctx | CTypErr of string

type exprtyp = ExpTyp of ityp | ETypErr of string

let update s v i = (fun x -> if x=v then i else (s x));;

let init_typctx (l : (varname*vartyp) list) : typctx =
  fun x -> (try (List.assoc x l) with Not_found -> Undeclared);;

let second x = match x with (a, b) -> b;;
let first x = match x with (a, b) -> a;;

(* test data *)

let gamma=init_typctx [("pork", VTyp(TypInt, true)); ("beef", VTyp(TypBool, true)); ("chicken", VTyp(TypInt, true))]

let formals0=[("pork", TypInt); ("beef", TypBool); ("chicken", TypInt)];;
let formals1=[("pork", TypInt); ("beef", TypBool); ("dingbats", TypInt)];;
let formals2=[("pork", TypInt)];;
let formals3=[("skugg", TypInt); ("sausages", TypBool); ("dingbats", TypInt)];;
let formals4=[("dingbats", TypBool)];;
let flist=[formals0; formals1; formals2; formals3; formals4];;

(* test data *)


let rec typchk_expr (tc:typctx) (e:iexpr) : exprtyp =
	let typchk_op (atyp:ityp) (rtyp:ityp) (e1:iexpr) (e2:iexpr) : exprtyp =
		if (typchk_expr tc e1)=ExpTyp(atyp) && (typchk_expr tc e2)=ExpTyp(atyp) then
			ExpTyp(rtyp)
		else
			(ETypErr "Error")
		in
	match e with
	| Const n -> ExpTyp(TypInt)
	| True -> ExpTyp(TypBool)
	| False -> ExpTyp(TypBool)
	| Var v -> (match (tc v) with 
				VTyp (t, b) -> if b=true then ExpTyp(t) else ETypErr ("Error")
				| Undeclared -> ETypErr ("Error"))
	| Plus (e1, e2) ->  (typchk_op TypInt TypInt e1 e2)
	| Minus (e1, e2)-> (typchk_op TypInt TypInt e1 e2)
	| Times (e1, e2)-> (typchk_op TypInt TypInt e1 e2)
	| Neg (e1) 		->	if (typchk_expr tc e1)=ExpTyp(TypBool)
						then ExpTyp(TypBool)
						else ETypErr("Error")
	| Conj (e1, e2) ->	(typchk_op TypBool TypBool e1 e2)
	| Disj (e1, e2) ->	(typchk_op TypBool TypBool e1 e2)
	| Leq (e1, e2) 	->	(typchk_op TypInt TypBool e1 e2)
	| Abstraction (p, c) -> if not (paramsAlreadyDefined tc p) then
								
							else
								(print_string "Error: Abstraction, parameters already defined");ETypErr("Error")
	| Apply (func, inputs) -> print_string("not implemented");ExpTyp(TypInt)
	;;

let paramsAlreadyDefined tc p =
	let orUndeclared bln typ = bln || (not (typ=Undeclared)) in
	let varToType v = tc (first v) in
	(List.fold_left orUndeclared false (List.map varToType p))

let getNewContext tc p = 
	let 

List.combine (first (List.split formals)) (List.map (fun x -> VTyp(x, true)) (second (List.split formals)));;

List.fold_left (fun accum elem->update accum (first elem) (second elem)) tc (List.combine (first (List.split formals)) (List.map (fun x -> VTyp(x, true)) (second (List.split formals))))



(*
	(List.fold_left (fun bln typ -> bln || (typ=Undeclared)) false (List.map (fun x -> tc (first x)) p))
*)

(List.map (fun x -> gamma (first x)) formals);;


	
let rec typchk_cmd (tc:typctx) (c:icmd) : cmdtyp =
  (match c with
     Skip -> TypCtx tc
   | Seq (c1,c2) -> (match (typchk_cmd tc c1) with
                       CTypErr s -> CTypErr s
                     | TypCtx tc2 -> (typchk_cmd tc2 c2))
   | Assign (v,e1) ->
      (match (tc v, typchk_expr tc e1) with
         (_, ETypErr s) -> CTypErr s
       | (VTyp (t1,_), ExpTyp t2) ->
           if t1=t2 then TypCtx (update tc v (VTyp (t1,true)))
           else CTypErr ("type-mismatch in assignment to "^v)
       | (Undeclared, _) -> CTypErr ("assignment to undeclared var "^v))
   | Cond (e1,c1,c2) ->
      (match (typchk_expr tc e1, typchk_cmd tc c1, typchk_cmd tc c2) with
         (ETypErr s, _, _) | (_, CTypErr s, _) | (_, _, CTypErr s) -> CTypErr s
       | (ExpTyp TypBool, TypCtx _, TypCtx _) -> TypCtx tc
       | (ExpTyp _, TypCtx _, TypCtx _) ->
            CTypErr "non-boolean expression used as 'if' test")
   | While (e1,c1) ->
      (match (typchk_expr tc e1, typchk_cmd tc c1) with
         (ETypErr s, _) | (_, CTypErr s) -> CTypErr s
       | (ExpTyp TypBool, TypCtx _) -> TypCtx tc
       | (ExpTyp _, TypCtx _) ->
            CTypErr "non-boolean expression used as 'while' test")
   | Decl (t,v) -> (match (tc v) with
                      Undeclared -> TypCtx (update tc v (VTyp (t,false)))
                    | _ -> CTypErr ("name conflict: "^v)));;


(* Your interpreter may throw the SegFault exception if it ever encounters
 * a stuck state.
 *)
exception SegFault

(* Stores now map variable names to either integers or code. Code consists
 * of a command and a list of the names of the variables it takes as input.
 *)
type heapval = Data of int | Code of (icmd * varname list)
type store = varname -> heapval

let init_store (l : (varname*heapval) list) : store =
  fun x -> List.assoc x l;;

let rec eval_expr (s:store) (e:iexpr) : heapval =
  let eval_intop f (e1,e2) =
    (match (eval_expr s e1, eval_expr s e2) with
       (Data n1, Data n2) -> Data (f n1 n2)
     | _ -> raise SegFault) in
  let eval_boolop f p =
    eval_intop (fun x y -> if (f (x<>0) (y<>0)) then 1 else 0) p in
  (match e with
     Const n -> Data n
   | Var x -> (s x)
   | Plus p -> eval_intop (+) p
   | Minus p -> eval_intop (-) p
   | Times p -> eval_intop ( * ) p
   | True -> Data 1
   | False -> Data 0
   | Leq p -> eval_intop (fun x y -> if x<=y then 1 else 0) p
   | Conj p -> eval_boolop (&&) p
   | Disj p -> eval_boolop (||) p
   | Neg e1 -> eval_boolop (fun x _ -> not x) (e1,True)
   | Abstraction (al,c) ->
       (* YOUR CODE GOES HERE
        * Replace the following line with an implementation of the
        * large-step operational semantics for function abstraction. *)
       raise SegFault
   | Apply (e1,el) ->
       (* YOUR CODE GOES HERE
        * Replace the following line with an implementation of the
        * large-step operational semantics for function application. *)
       raise SegFault
  )

and exec_cmd (s:store) (c:icmd) : store =
  (match c with
     Skip | Decl _ -> s
   | Seq (c1,c2) -> exec_cmd (exec_cmd s c1) c2
   | Assign (v,e) -> update s v (eval_expr s e)
   | Cond (e,c1,c2) ->
       exec_cmd s (if (eval_expr s e)=(Data 0) then c2 else c1)
   | While (e,c1) -> exec_cmd s (Cond (e,Seq (c1,c),Skip))
  );;



let main () =
   let argval = (function "true" -> 1 | "false" -> 0 | x -> int_of_string x) in
   let argtyp = (function "true" | "false" -> TypBool | _ -> TypInt) in
   let c = (Impparser.parse_cmd Implexer.token 
              (Lexing.from_channel (open_in Sys.argv.(1)))) in
   let s = init_store (List.tl (List.tl (Array.to_list (Array.mapi
             (fun i a -> ("arg"^(string_of_int (i-2)),
                          Data (if i>=2 then (argval a) else 0)))
               Sys.argv)))) in
   let tc = init_typctx (List.tl (List.tl (Array.to_list (Array.mapi
             (fun i a -> ("arg"^(string_of_int (i-2)), VTyp (argtyp a,true)))
             Sys.argv)))) in
   (match (typchk_cmd tc c) with
      CTypErr s -> print_string ("Typing error: "^s^"\n")
    | TypCtx tc' -> (print_string
        (match (tc' "ret") with
           Undeclared -> "Typing error: return value undeclared"
         | VTyp(_,false) -> "Typing error: return value uninitialized"
         | VTyp(rtyp,true) ->
             (match (exec_cmd s c "ret") with
                Code _ -> "<code>"
              | Data n -> if rtyp=TypInt then (string_of_int n)
                          else if n=0 then "false" else "true"));
        print_newline ()));;

main ();;