let rec compile_datatype_init dt = match dt with
    (Ast.SynIntType
    | Ast.SynFloatType
    | Ast.SynStringType
    | Ast.SynBoolType
    | Ast.SynVoidType
    | Ast.SynRefType _) -> [Instruction ConstUninit]
  | Ast.SynEnumOrStructType (name,field_types) -> 
      (** field_types is empty if its an enum/template *)

      if List.length !field_types > 0 then
        let n_fields = List.length !field_types in
        let fields_result = compile_datatypes_pushing !field_types in
          fields_result
          @ [Instruction (Rev n_fields)]
          @ [Instruction (MakeBlockStatic (1,n_fields))]
      else
        [Instruction ConstUninit]
  | Ast.SynArrayType (t_arr,vprod) ->
      let dt_code = compile_datatype_init t_arr in
      let vprod_code = compile_value_producer vprod in
        dt_code 
        @ [Instruction Push]
        @ vprod_code
        @ [Instruction (MakeBlockFilled 0)]
  | Ast.SynListType _ -> 
      [Instruction Nil]
  | Ast.SynArrowType (_,_) -> [Instruction (ConstString "")]

(** Compiles each data type in dt_list, inserting push instructions between each compilation result *)

and compile_datatypes_pushing dt_list = match dt_list with
    dt::rest -> (compile_datatype_init dt)@[Instruction Push]@(compile_datatypes_pushing rest)
  | [] -> []

(** Compiles an expression *)

and compile_expression expr = match expr with
    Ast.SynVarDeclare vdecl -> compile_variable_declaration vdecl
  | Ast.SynEnumDeclare edecl -> []
  | Ast.SynVarAssign vasgn -> compile_variable_assignment vasgn
  | Ast.SynCond cond -> compile_conditional cond
  | Ast.SynLoop loop -> compile_loop loop
  | Ast.SynFunctionCall funcall -> compile_function_call funcall
  | Ast.SynReturnStatement ret -> compile_return ret
  | Ast.SynBreak -> [Break]
  | Ast.SynContinue -> [Continue]

(** Compiles a list of expressions *)

and compile_expression_list expr_list = match expr_list with
    cur::rest -> 
      let curbuf = compile_expression cur in
      let restbuf = compile_expression_list rest in
        curbuf@restbuf
  | [] -> []


(** Compiles a variable declarations *)

and compile_variable_declaration vdecl = match vdecl with
    Ast.SynVarDeclareNoInit (dt, varname) -> 
      let dt_init = compile_datatype_init dt in
        dt_init @ [SetVar varname]
  | Ast.SynVarDeclareWithInit(_, varname, vprod) -> 
      let valbuf = compile_value_producer vprod in
        valbuf@[SetVar varname]

(** Compiles a conditional. Would be nice to add short-circuiting in the future. *)

and compile_conditional cond = match cond with
    Ast.SynIf (vp,expr_list) -> 
      let vp_result = compile_value_producer vp in
      let expr_result = compile_expression_list expr_list in
        [If (vp_result, expr_result, [])]
  | Ast.SynIfCase (vp,expr_list,continued_cond) ->
      let vp_result = compile_value_producer vp in
      let expr_result = compile_expression_list expr_list in
      let continued_result = compile_continued_conditional continued_cond in
        [If (vp_result, expr_result, continued_result)]

(** Compiles an else case *)

and compile_continued_conditional cond = match cond with
    Ast.SynFinalElse expr_list -> compile_expression_list expr_list
  | Ast.SynElse cond -> compile_conditional cond

(** Compiles a loop *)

and compile_loop loop = match loop with
    Ast.SynWhile (vprod,lexpr_list) -> 
      let vp_result = compile_value_producer vprod in
      let lexpr_result = compile_expression_list lexpr_list in
        [While (vp_result,lexpr_result)]
  | Ast.SynFor (init,test,step,body) -> 
      let init_result = compile_expression init in
      let test_result = compile_value_producer test in 
      let step_result = compile_expression step in
      let body_result = compile_expression_list body in
        [For (init_result, test_result, step_result, body_result)]
  | Ast.SynDoWhile (lexpr_list, vprod) ->
      let vp_result = compile_value_producer vprod in
      let lexpr_result  = compile_expression_list lexpr_list in
        [While (lexpr_result,vp_result)]

(** Compiles a value *)

and compile_value value = match value with 
    Ast.SynIntValue i -> [Instruction (ConstInt i)]
  | Ast.SynFloatValue f -> [Instruction (ConstFloat f)]
  | Ast.SynBoolValue b -> [Instruction (ConstInt (if b then 1 else 0))]
  | Ast.SynStringValue s -> [Instruction (ConstString s)]

(** Compiles a value produder *)

and compile_value_producer vprod = match vprod with 
    Ast.SynValue value -> compile_value value
  | Ast.SynFunctionCallValue funcall -> compile_function_call funcall
  | Ast.SynVarIdentifier vident -> compile_get_variable_identifier vident
  | Ast.SynBinop (vp1,op,vp2) -> compile_binary_operation vp1 op vp2
  | Ast.SynPrefixUnop (op,vp) -> compile_prefix_unary_operation op vp
  | Ast.SynParenthesized vprod -> compile_value_producer vprod
  | Ast.SynArrayValueProducer vprod_list ->
      let n = List.length vprod_list in
      let values_result = compile_value_producer_list_pushing vprod_list in
        values_result 
        @ [Instruction (Rev n);
           Instruction (MakeBlockStatic (0,n))]
  | Ast.SynListValueProducer lvprod -> compile_list_value_producer lvprod

(** Compiles each value producer in order, pushing the results onto the stack *)

and compile_value_producer_list_pushing vp_list = match vp_list with
    cur::rest -> 
      let cur_result = compile_value_producer cur in
      let rest_result= compile_value_producer_list_pushing rest in
        cur_result
        @ [Instruction Push]
        @ rest_result
  | [] -> []

(** Compiles a list value producer *)

and compile_list_value_producer lvprod = match lvprod with
    Ast.SynListNil _ -> [Instruction Nil]
  | Ast.SynListList vprod_list -> 
      let result = compile_value_producer_list_pushing vprod_list in
        result
        @ [Instruction Nil]
        @ (repeat_list [Instruction Cons] (List.length vprod_list))
  | Ast.SynListCons (vp1,vp2) ->
      let result_car = compile_value_producer vp1 in
      let result_cdr = compile_value_producer vp2 in
        result_car
        @ [Instruction Push]
        @ result_cdr
        @ [Instruction Cons]

(** Compiles a variable assignment *)

and compile_variable_assignment vasgn = match vasgn with 
    Ast.SynVarAssignment (vident,vprod) ->
      let vp_result = compile_value_producer vprod in
      let setvar_result = compile_set_variable_identifier vident in
        vp_result @ setvar_result
  | Ast.SynVarModify (vident, op, vprod) ->
      let vp1, vp2 = Ast.SynVarIdentifier vident, vprod
      in
      let op_result = compile_value_producer 
        (Ast.SynBinop (vp1, op, vp2)) in
      let setvar_result = compile_set_variable_identifier vident in
        op_result @ setvar_result

(** Produces code that sets the variable identifier to the value in the accumulator. Leaves the value in the accumulator *)

and compile_set_variable_identifier vident =
  match vident with
      Ast.SynVarName s -> [SetVar s]
    | Ast.SynStructOrEnumValue (vid1,s2,ftype) ->
        (match !ftype with
             Ast.VIdStructField index ->
               let getstruct = compile_get_variable_identifier vid1 in
                 [Instruction Push]
                 @ getstruct
                 @ [Instruction (SetElemStatic index)] 
                     (** structs are reference types; we're done at this point *)

           | Ast.VIdEnumValue _ ->
               raise_compile_error ["Unexpected compile error: cannot set an enum value."]
           | Ast.VIdUnspecified ->
               raise_compile_error ["Unexpected compile error: field index ";s2;" was not determined by type checker."])
    | Ast.SynArrayCell (vid,vprod) ->
        let vid_result = compile_get_variable_identifier vid in
        let vprod_result = compile_value_producer vprod in
          [Instruction Push]
          @ vprod_result
          @ [Instruction Push]
          @ vid_result
          @ [Instruction SetElem]

(** Get a variable identifier into the accumulator *)

and compile_get_variable_identifier vident =
  match vident with
      Ast.SynVarName s -> [GetVar s]
    | Ast.SynStructOrEnumValue (vid1,s2,ftype) ->  
        (match !ftype with
             Ast.VIdStructField index ->
               let getstruct = compile_get_variable_identifier vid1 in
                 getstruct @ [Instruction (GetElemStatic index)]
           | Ast.VIdEnumValue index ->
               [Instruction (ConstInt index)]
           | Ast.VIdUnspecified -> 
               raise_compile_error ["Unexpected compile error: field index ";s2;" was not determined by type checker."])
    | Ast.SynArrayCell (vid,vprod) ->
        let vid_result = compile_get_variable_identifier vid in
        let vprod_result = compile_value_producer vprod in
          vprod_result 
          @ [Instruction Push]
          @ vid_result
          @ [Instruction GetElem]

(** Compiles a binary operation expression *)

and compile_binary_operation vp1 op vp2 = 
  let vp1_result = compile_value_producer vp1 in
  let vp2_result = compile_value_producer vp2 in
  let op_command = match op with
      Ast.SynBinopAnd -> [Instruction And]
    | Ast.SynBinopOr -> [Instruction Or]
    | Ast.SynBinopAdd -> [Instruction Add]
    | Ast.SynBinopSub -> [Instruction Sub]
    | Ast.SynBinopMul -> [Instruction Mul]
    | Ast.SynBinopDiv -> [Instruction Div]
    | Ast.SynBinopIDiv ->[Instruction DivI]
    | Ast.SynBinopMod -> [Instruction RemI]
    | Ast.SynBinopConcat -> [Instruction Concat]
    | Ast.SynBinopCons -> [Instruction Cons]
    | Ast.SynCompLt -> [Instruction Lt]
    | Ast.SynCompGt -> [Instruction Gt]
    | Ast.SynCompLte ->[Instruction Lte]
    | Ast.SynCompGte ->[Instruction Gte]
    | Ast.SynCompEq -> [Instruction Eq]
    | Ast.SynCompNeq ->[Instruction Neq]
  in
    vp2_result 
    @ [Instruction Push]
    @ vp1_result
    @ op_command
                         
(** Compiles unary operations *)
   
and compile_prefix_unary_operation op vp =
    let vp_result = compile_value_producer vp in
    let op_command = match op with 
        Ast.SynUnopNot -> [Instruction Push;
                           Instruction (ConstInt 1);
                           Instruction Add;
                           Instruction Push;
                           Instruction (ConstInt 2);
                           Instruction Swap;
                           Instruction RemI]
      | Ast.SynUnopCar -> [Instruction Car]
      | Ast.SynUnopCdr -> [Instruction Cdr]
      | Ast.SynUnopTrunc -> [Instruction Int]
      | Ast.SynUnopDeref -> [Instruction (GetElemStatic 0)]
      | Ast.SynUnopNeg -> [Instruction Neg]
      | Ast.SynUnopNull -> [Instruction IsNull]
    in
      vp_result @ op_command

(** Compiles a function call. Doesn't use tail-recursion -- this would be nice to add in the future. *)

and compile_function_call funcall = match funcall with
    Ast.SynLocalCall (fname,vprod_list,isvar) -> 
      let n_args = List.length vprod_list in
      let args_result = compile_value_producer_list_pushing vprod_list in
      let ret_label = make_label (concat ["returnfrom_local_";fname]) in
      let call_instruction = 
        if !isvar then 
          [GetVar fname;
           Instruction Apply]
        else
          [Instruction (Call fname)]
      in
        [Instruction (Comment (concat ["Local call to ";fname]));
         Instruction (PushSf ret_label);
         BeginScope]
        @ args_result
        @ [Instruction (Rev n_args)]
        @ call_instruction
        @ [EndScopeSf;
           Instruction (Label ret_label)]
  | Ast.SynRemoteCall (fname,vprod_list,ret_var) ->
      let n_args = List.length vprod_list in
      let args_result = compile_value_producer_list_pushing vprod_list in
      let ret_label = make_label (concat ["returnfrom_remote_withresult_";fname]) in
      let done_label = make_label (concat ["done_interpreting_remote_results_";fname]) in
      let vident_set_result = compile_set_variable_identifier ret_var in
        [Instruction (Comment (concat ["Remote call with result to ";fname]));
         Instruction (PushSf ret_label);
         BeginScope]
        @ args_result
        @ [Instruction (Rev n_args);
           Instruction (RPC fname);
           EndScopeSfRPC;
           Instruction (Label ret_label); 
              (** Acc || Stack = success || result *)

           Instruction (Jz done_label);
           Instruction Swap
             (** result || success *)

        @ vident_set_result 
          (** ? || success *)

        @ [Instruction Swap
           (** success || ? *)

           Instruction (Label done_label); 
              (** success || ? *)

           Instruction Swap
             (** ? || success *)

           Instruction (Acc 0); 
              (** success || success *)

           Instruction Pop
             (** success || *)

           
  | Ast.SynRemoteCallNoResult (fname, vprod_list) ->
      let n_args = List.length vprod_list in
      let args_result = compile_value_producer_list_pushing vprod_list in
      let ret_label = make_label (concat ["returnfrom_local_";fname]) in
        [Instruction (Comment (concat ["Remote call with no result to ";fname]));
         Instruction (PushSf ret_label);
         BeginScope]
        @ args_result
        @ [Instruction (Rev n_args);
           Instruction (RPC fname);
           EndScopeSfRPC;
           Instruction (Label ret_label); 
              (** success || result *)

           Instruction Swap
             (** result || success *)

           Instruction (Acc 0); 
              (** success || success *)

           Instruction Pop
             (** success || *)

              
(** Compiles a return statement *)

and compile_return ret = match ret with
    Ast.SynVoidReturn ->
      [Instruction ConstUninitInstruction Return
  | Ast.SynValueReturn vprod ->
      let vp_result = compile_value_producer vprod in
        vp_result@[Instruction Return]