let rec type_data_types dt_lst env =
  match dt_lst with
      Ast.SynIntType::rest -> TyInt::(type_data_types rest env)
    | Ast.SynFloatType::rest -> TyFloat::(type_data_types rest env)
    | Ast.SynStringType::rest -> TyString::(type_data_types rest env)
    | Ast.SynBoolType::rest -> TyBool::(type_data_types rest env)
    | Ast.SynVoidType::rest -> TyVoid::(type_data_types rest env)
    | (Ast.SynEnumOrStructType (s,field_types))::rest ->
        if isdef_struct s env then 
          let _ = field_types  := get_struct_data_type_list s env in
            (TyStruct s)::(type_data_types rest env)
        else if isdef_enum s env then 
          (TyEnum s)::(type_data_types rest env)
        else if isdef_templated s env then
          (TyTemplate s)::(type_data_types rest env)
        else raise_type_error ["Invalid data type: ";s;" expected enum, struct, or templated type."]
    | (Ast.SynArrayType (dt,n))::rest ->
        let t_n,_ = type_value_producer n env in
          if t_n = TyInt then 
            (TyArray (type_data_type dt env))::(type_data_types rest env)
          else
            raise_type_error ["Invalid array index type ";string_of_type t_n;" expected an integer value."]
    | (Ast.SynListType dt)::rest ->
        (TyList (type_data_type dt env))::(type_data_types rest env)
    | (Ast.SynRefType dt)::rest ->
        (TyRef (type_data_type dt env))::(type_data_types rest env)
    | (Ast.SynArrowType (arglist_types,ret_type))::rest ->
        let arglist_types = type_data_types arglist_types env in
          (TyArrow ((if arglist_types = [] then [TyVoidelse arglist_types), 
                    type_data_type ret_type env))::(type_data_types rest env)
    | [] -> []

(** Types a single AST data type element *)

and type_data_type dt env = 
  let verified_type_lst = type_data_types [dt] env in
    match verified_type_lst with 
        x::rest -> x
      | [] -> raise_type_error ["Unexpected type error."]

(** Types the declaration of a list of struct fields. Initial values not allowed, type error if they are. *)

and structdef_list lst env = match lst with
    (Ast.SynVarDeclareNoInit (dt,s))::[] -> [s,type_data_type dt env]
  | (Ast.SynVarDeclareNoInit (dt,s))::rest -> (s,type_data_type dt env)::(structdef_list rest env)
  | _ -> raise_type_error ["Expected uninitialized variable declaration in struct definition."

(** Types an argument list to a function, adding the arguments as variable declarations to the environment. *)

and vardef_arglist arglist env = 
  match arglist with 
      (dt,name)::rest -> vardef_arglist rest ((TyVarDef (name,type_data_type dt env))::env)
    | [] -> env

(** Types a value *)

and type_value v env = match v with
    Ast.SynIntValue _ -> TyInt, env
  | Ast.SynFloatValue _ -> TyFloat, env
  | Ast.SynBoolValue _ -> TyBool, env
  | Ast.SynStringValue _ -> TyString, env

(** Produces a comma-separated string representation of a list of types *)

and string_of_type_list lst = match lst with
    t::[] -> string_of_type t
  | t::rest -> String.concat "" [string_of_type t;", ";string_of_type_list rest]
  | [] -> ""

(** Checks if association list l1 has no conflicting key/value pairs with association list l2 *)

and are_assoclists_compatible l1 l2 = match l1 with
    (x,y)::rest -> 
      if List.mem_assoc x l2 
      then y = List.assoc x l2
      else are_assoclists_compatible rest l2
  | [] -> true

(** Returns an association list of template types to bmdtypes. Type error if t2 cannot be unified to t1. *)

and unify_types t1 t2 = match t1,t2 with
    x,y when x = y -> []
  | TyList t_list1, TyList t_list2 -> unify_types t_list1 t_list2
  | TyArray t_arr1, TyArray t_arr2 -> unify_types t_arr1 t_arr2
  | TyArrow (args1,ret1), TyArrow (args2,ret2) -> 
      let assoc1 = unify_types ret1 ret2 in
      let assoc2 = List.flatten (List.map2 unify_types args1 args2) in
        if are_assoclists_compatible assoc1 assoc2 then
          assoc1 @ assoc2
        else 
          raise_type_error ["Could not unify templated arrow type ";
                            string_of_type t2;
                            " with ";
                            string_of_type t1]
  | TyRef t_ref1, TyRef t_ref2 -> unify_types t_ref1 t_ref2
  | TyTemplate s, t2 -> [(s,t2)]
  | _ -> raise_type_error ["Expected type ";
                           string_of_type t1;
                           " but got type ";
                           string_of_type t2]

(** Uses the association list (substitution list) template_map (key: template string, value: bmdtype) to type the given data type with those substitutions *)

and insert_template_types template_map env dt = 
  let insert_types = insert_template_types template_map env in
    match dt with
        TyList t -> TyList (insert_types t)
      | TyArray t -> TyArray (insert_types t)
      | TyArrow (args,ret) -> TyArrow (List.map insert_types args, insert_types ret)
      | TyRef t -> TyRef (insert_types t)
      | TyTemplate s -> 
          if List.mem_assoc s template_map then
            List.assoc s template_map
          else if isdef_templated s env then
            TyTemplate s
          else 
            raise_type_error ["Expression has free template type ";string_of_type dt;" in result."]
      | x -> x

(** Apply argtypes to the arrow type, making sure there are no template inconsistencies, and get the return type *)

and apply_arrow_type arrowtype argtypes env = 
  let lhs_types, ret_type = match arrowtype with
      TyArrow (x,y) -> x,y
    | _ -> raise_type_error ["Attempted to apply arguments to something of non-arrow type ";string_of_type arrowtype;"."]
  in
  let isVoidArgs = lhs_types = [TyVoid&& (List.length argtypes = 0) in
  let _ = 
    if (not isVoidArgs) && ((List.length lhs_types) != (List.length argtypes))
    then raise_type_error ["Attempted to apply an incorrect number of arguments to arrow type ";string_of_type arrowtype;"."]
    else ()
  in
  let template_map = ref [] in
  let _ = 
    if isVoidArgs then () else
      for i = 0 to (List.length lhs_types)-1 do
        let cur_lhs, cur_arg = List.nth lhs_types i, List.nth argtypes i in
        let unify_result = unify_types cur_lhs cur_arg in
          if are_assoclists_compatible unify_result !template_map then
            template_map := unify_result @ !template_map
          else
            raise_type_error ["Could not apply argument types ";
                              string_of_type_list argtypes;
                              " to a function of type ";
                              string_of_type arrowtype]
      done
  in
    insert_template_types !template_map env ret_type
      
(** Types a function call as a value-producer (checks argument types, gives the return type). Updates the linker header with inferred remote call types. *)

and type_function_call_value funcall env = match funcall with
    Ast.SynLocalCall (s,vprod_list,isvar) -> 
      if isdef_fun s env || isdef_var s env then
        let fun_type = 
          if isdef_fun s env then 
            gettype_fun s env 
          else 
            let _ = isvar := true in
              gettype_var s env 
        in
        let vplist_types,_ = type_value_producer_list_nonuniform vprod_list env in
          try
            apply_arrow_type fun_type vplist_types env, env
          with
              Type_error err_string ->
                raise_type_error ["Call to (local) function ";s;" was malformed. ";err_string]
      else 
        raise_type_error ["(Local) function call to undefined function ";s;"."]
  | Ast.SynRemoteCall (s,vprod_list, var_ident) -> 
       (** the linker must do most of the work here **)

      let argtypes,_ = type_value_producer_list_nonuniform vprod_list env in
      let rettype,_ = type_variable_identifier var_ident env in
      let _ = append_link_buffer (concat ["require ";s;" = ";expanded_string_of_type (TyArrow (argtypes,rettype)) env;"\n";]) in
        TyBool, env 
          (** the result is true or false depending on call success/failure **)

  | Ast.SynRemoteCallNoResult (s,vprod_list) -> 
      (** again, the linker will do most of the work **)

      let argtypes,_ = type_value_producer_list_nonuniform vprod_list env in
      let rettype = TyTemplate ("_unknown"in
      let _ = append_link_buffer (concat ["require ";s;" = ";expanded_string_of_type (TyArrow (argtypes,rettype)) env;"\n";]) in
        TyBool, env
        
(** Types a binary operation vp1 op vp2. Type error if not a valid operation *)

and type_binop vp1 op vp2 env =
  let t_vp1,_ = type_value_producer vp1 env in
  let t_vp2,_ = type_value_producer vp2 env in
    if isallowed_binop op t_vp1 t_vp2 then
      (gettype_binop op t_vp1 t_vp2), env
    else 
      raise_type_error ["Attempted to perform an invalid binary operation ";Ast.string_of_binop op;" on values of type ";string_of_type t_vp1;" and ";string_of_type t_vp2;"."]
    
(** Types a unary operation expression. Type error if not a valid operation. *)

and type_prefix_unop op vp env = 
  let t_vp,_ = type_value_producer vp env in
    match (op,t_vp) with 
        Ast.SynUnopNotTyBool -> TyBool, env
      | Ast.SynUnopCarTyList t_list -> t_list, env
      | Ast.SynUnopCdrTyList t_list -> TyList t_list, env
      | Ast.SynUnopTrunc, (TyFloat | TyInt-> TyInt, env
      | Ast.SynUnopDerefTyRef t_ref -> t_ref, env
      | Ast.SynUnopNegTyInt -> TyInt, env
      | Ast.SynUnopNegTyFloat -> TyFloat, env
      | Ast.SynUnopNull, _ -> TyBool, env
      | _ -> raise_type_error ["Attempted to perform an invalid prefix unary operation on a value of type ";string_of_type t_vp;"."]

(** Types an array value producer (i.e. . Error if empty (we need to infer the type), or if values of different types are used. *)

and type_array_value_producer vp_list env = match vp_list with
    vp::[] ->
      let vp_type,_ = type_value_producer vp env in
        TyArray vp_type, env
  | vp::rest ->
      let vp_type,_ = type_value_producer vp env in
      let rest_type,_ = type_array_value_producer rest env in
        (match rest_type with
             TyArray rest_arr_type when rest_arr_type = vp_type ->
               TyArray vp_type, env
           | _ -> raise_type_error ["An element of type ";string_of_type vp_type;" is being used with an array of type ";string_of_type rest_type;"."])
  | [] -> raise_type_error ["Constant array values must be non-empty."]

(** Types a list of value producers (i.e. elem1; elem2;...) Error if empty or if values of different types are used. *)

and type_value_producer_list vp_list env = match vp_list with
    vp::[] ->
      let vp_type,_ = type_value_producer vp env in
        TyList vp_type, env
  | vp::rest ->
      let vp_type,_ = type_value_producer vp env in
      let rest_type,_ = type_value_producer_list rest env in
        if TyList vp_type = rest_type then
          TyList vp_type, env
        else 
          raise_type_error ["An element of type ";string_of_type vp_type;" is being used with list of type ";string_of_type rest_type;"."]
  | [] -> raise_type_error ["Constant list values must be non-empty."]

(** Types a list value producer *)

and type_list_value_producer vp_list env = match vp_list with
    Ast.SynListNil dt -> 
      let t_dt = type_data_type dt env in
        TyList t_dt, env
  | Ast.SynListList vp_list ->
      type_value_producer_list vp_list env
  | Ast.SynListCons (vp1,vp2) ->
      let t_vp1,_ = type_value_producer vp1 env in
      let t_vp2,_ = type_value_producer vp2 env in
        (match t_vp2 with 
            TyList t_list when t_list = t_vp1 -> t_vp2, env
          | _ -> raise_type_error ["Cannot cons a value of type ";string_of_type t_vp1;" to a list of type ";string_of_type t_vp2;"."])

(** Types a value producer *)

and type_value_producer vp env = match vp with
    Ast.SynValue v -> type_value v env
  | Ast.SynFunctionCallValue funcall -> type_function_call_value funcall env
  | Ast.SynVarIdentifier vident -> type_variable_identifier vident env 
  | Ast.SynBinop (vp1,op,vp2) -> type_binop vp1 op vp2 env
  | Ast.SynPrefixUnop (op,vp) -> type_prefix_unop op vp env
  | Ast.SynParenthesized vp -> type_value_producer vp env
  | Ast.SynArrayValueProducer vp_list -> type_array_value_producer vp_list env
  | Ast.SynListValueProducer vp_list -> type_list_value_producer vp_list env

(** Returns a list of types, i.e. for parameters *)

and type_value_producer_list_nonuniform vp_list environment =  
  let helper vplist env = 
    match vplist with
        vp::rest -> 
          let t_vp,_ = type_value_producer vp env in
          let t_rest,_ = type_value_producer_list_nonuniform rest env in
            t_vp::t_rest
      | [] -> []
  in
    helper vp_list environment, environment

(** Types a variable identifier *)

and type_variable_identifier v_ident env = match v_ident with
    Ast.SynVarName s -> 
      if isdef_var s env then
        gettype_var s env, env
      else if isdef_enum s env then
        TyEnumType s, env
      else if isdef_struct s env then
        TyStruct s, env
      else if isdef_fun s env then
        gettype_fun s env, env
      else
        raise_type_error ["Variable ";s;" was used but not defined."]
  | Ast.SynStructOrEnumValue (vid1,s2,field_info) ->
      let t_vid,_ = type_variable_identifier vid1 env in
        (match t_vid with
             TyEnumType s1 -> 
               if is_enum_value s1 s2 env then
                 let index = get_enum_value s1 s2 env in
                 let _ = field_info := (Ast.VIdEnumValue index) in
                   TyEnum s1, env
               else 
                 raise_type_error [s1;".";s2;" is not an enum value of enum type ";s1;"."]
           | TyStruct s1 ->
               if isdef_struct s1 env then
                 if is_struct_value s1 s2 env then
                   let index = getfield_struct s1 s2 env in
                   let _ = field_info := (Ast.VIdStructField index) in
                   gettype_struct s1 s2 env, env
                 else
                   raise_type_error [s1;".";s2;" refers to a non-existent field of struct type ";string_of_type t_vid;"."]
               else
                 raise_type_error [s1;" is used as a struct but is not a struct."]
           | _ -> raise_type_error ["An identifier of type ";string_of_type t_vid;" is not a struct or enum type in this scope."])
  | Ast.SynArrayCell (vp,i) -> 
      let t,_ = type_variable_identifier vp env in
      let t_index,_ = type_value_producer i env in
        (match (t,t_index) with
             TyArray t_arr, TyInt ->
               t_arr, env
           | _ -> raise_type_error ["A value of non-array-type ";string_of_type t;" is used as an array type."])